perm filename EUR[AM,DBL] blob
sn#586898 filedate 1981-05-19 generic text, type T, neo UTF8
(FILECREATED "18-MAY-81 18:54:38" {DSK⎇EUR.;1 345131
changes to: MergeTasks WorkOnTask WorkOnUnit UserImpatience AllPairs Interp2 START (
NonEmptyStruc FastDefn) (Defn SubSlots) (H29 IfWorkingOnTask) (H29 IfFinishedWorkingOnTask) (
EmptyStruc ElimSlots) (OSet ElimSlots) (Bag ElimSlots) (List ElimSlots) (H19Criterial
IfFinishedWorkingOnTask) (H9 ThenCompute) (H9 ThenComputeRecord) (H9 ThenPrintToUserRecord) (H9
OverallRecord) (Set ElimSlots) EURCOMS EURVARS EURFNS (H4 ThenAddToAgenda)
previous date: " 1-May-81 01:28:10" {DSK⎇EUR.;1)
(PRETTYCOMPRINT EURCOMS)
(RPAQQ EURCOMS [(VARS * EURVARS)
(FNS * EURFNS)
(PROP ALL * Units)
[P (ADVISE (QUOTE EDITP)
(QUOTE BEFORE)
(QUOTE (OR (STKPOS (QUOTE EU))
(PRIN1 "
WARNING: ARE YOU SURE YOU REALLY DON'T MEAN 'EU' ??? !!! "]
[P (ADVISE (QUOTE MAKEFILE)
(QUOTE BEFORE)
(QUOTE (CheckElim]
[P (ADVISE (QUOTE PRINTDEF)
(QUOTE AROUND)
(QUOTE (IF (NUMBERP (FIRSTATOM EXPR))
THEN
(RESETVARS (PRETTYFLG)
(RETURN *))
ELSE *]
(GLOBALVARS AbortTask? AddedSome Agenda AreUnits CRLF CSlot CSlotSibs CTask Conjectures
CreditTo Creditors CurPri CurReasons CurSlot CurSup CurUnit CurVal DeletedUnits
ESYSPROPS EditpTemp FailureList GCredit GSlot HaveGenl HaveSpec HeuristicAgenda
Interp LastEdited MaybeFailed MapCycleTime MinPri MoveDefns NUnitSlots NeedGenl
NeedSpec NewU NewUnit NewUnits NewValue NewValues NotForReal nF nT OldKBPu
OldKBPv OldVal OldValue PosCred RArrow RCU SPACE SYSPROPS ShorterNam SlotToChange
SlotsToChange SlotsToElimInitially Slots SpecialNonUnits SynthU TTY TaskNum
TempCaches UDiff UndoKill Units UnusedSlots UsedSlots UserImpatience Verbosity
WarnSlots conjec cprintmp)
(P (SETQ SYSPROPS (UNION ESYSPROPS SYSPROPS)))
[P (ADVISE (QUOTE LOGOUT)
(QUOTE BEFORE)
(QUOTE (DRIBBLE]
[P (ADVISE (QUOTE LOGOUT)
(QUOTE AFTER)
(QUOTE (SOS]
[P (AND (NULL (GETD (QUOTE OldPACK*)))
(PUTD (QUOTE OldPACK*)
(GETD (QUOTE PACK*)))
(PUTD (QUOTE PACK*)
(GETD (QUOTE SmartPACK*]
(P (InitializeEurisko))
(P (CPRIN1 0 CRLF
"You may call (InitialCheckInv) to ferret out references to now-defunct units"
CRLF CRLF "Type (Eurisko) when you are ready to start." CRLF CRLF))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA EU)
(NLAML)
(LAMA SmartPACK* CPRIN1]
)
(RPAQQ EURVARS (Agenda CRLF Conjectures DeletedUnits ESYSPROPS FailureList GFNS Interp MinPri
MoveDefns NotForReal NUnitSlots NewU OldKBPu OldKBPv RArrow SPACE Slots
SlotsToElimInitially SpecialNonUnits SynthU TAB TempCaches UndoKill Units
UnusedSlots UsedSlots UserImpatience Verbosity ZZ (FONTCHANGEFLG)
(CHANGESARRAY)
(PROMPT#FLG T)))
(RPAQQ Agenda NIL)
(RPAQQ CRLF "
")
(RPAQQ Conjectures NIL)
(RPAQQ DeletedUnits NIL)
(RPAQQ ESYSPROPS (ALTOMACRO BYTEMACRO SOPVAL OPCODE))
(RPAQQ FailureList (NIL Failed))
(RPAQQ GFNS (AverageWorths Check2AfterEditp CreateUnit DefineSlot HasHighWorth InitializeEurisko
Interp1 Interp2 KillUnit NU REM1PROP RunAlg START TrueIfItExists UnionProp
Unitp WorkOnTask WorkOnUnit XeqIfItExists))
(RPAQQ Interp Interp2)
(RPAQQ MinPri 150)
(RPAQQ MoveDefns ((MOVD (QUOTE AND)
(QUOTE AND-2)
T)
(MOVD (QUOTE AND)
(QUOTE AND-1)
T)
(MOVD (QUOTE AND)
(QUOTE AND-1)
T)
(MOVD (QUOTE BestSubset)
(QUOTE BestSubset-3)
T)
(MOVD (QUOTE BestSubset)
(QUOTE BestSubset-2)
T)
(MOVD (QUOTE BestSubset)
(QUOTE BestSubset-1)
T)
(MOVD (QUOTE AND)
(QUOTE AND-2)
T)
(MOVD (QUOTE AND)
(QUOTE AND-1)
T)))
(RPAQQ NotForReal NIL)
(RPAQQ NUnitSlots NIL)
(RPAQQ NewU NIL)
(RPAQQ OldKBPu (g h))
(RPAQQ OldKBPv (EQ StrucEqual SetEqual OSetEqual BagEqual ListEqual MEMBER MEMB))
(RPAQQ RArrow ->)
(RPAQQ SPACE % )
(RPAQQ Slots (Abbrev Alg ApplicGenerator Applics Arity CompiledDefn ConjectureAbout Conjectures
Creditors DataType Defn DirectApplics Domain DontCopy DoubleCheck EachElementIsA
ElimSlots English Examples Extensions FailedRecord FailedRecordFor FastAlg
FastDefn Format Generalizations Generator HigherArity IfAboutToWorkOnTask
IfFinishedWorkingOnTask IfParts IfPotentiallyRelevant IfTaskParts
IfTrulyRelevant IfWorkingOnTask InDomainOf IndirectApplics IntApplics
IntExamples Interestingness Inverse IsA IsAInt IsRangeOf IterativeAlg
IterativeDefn LessInteresting LowerArity MoreInteresting NecDefn NonExamples
OverallRecord Range Rarity Record RecordFor RecursiveAlg RecursiveDefn
Restrictions SibSlots Specializations SubSlots SubsumedBy Subsumes SufDefn
SuperSlots ThenAddToAgenda ThenAddToAgendaFailedRecord ThenAddToAgendaRecord
ThenCompute ThenComputeFailedRecord ThenComputeRecord ThenConjecture
ThenConjectureFailedRecord ThenConjectureRecord ThenDefineNewConcepts
ThenDefineNewConceptsFailedRecord ThenDefineNewConceptsRecord
ThenDeleteOldConcepts ThenDeleteOldConceptsFailedRecord
ThenDeleteOldConceptsRecord ThenModifySlots ThenModifySlotsFailedRecord
ThenModifySlotsRecord ThenParts ThenPrintToUser ThenPrintToUserFailedRecord
ThenPrintToUserRecord ToDelete ToDelete1 Transpose UnitizedAlg UnitizedDefn
WhyInt Worth))
(RPAQQ SlotsToElimInitially NIL)
(RPAQQ SpecialNonUnits (T NIL))
(RPAQQ SynthU (H19Criterial H5Criterial H5Good HAvoid2AND HAvoid3First HAvoidIfWorking))
(RPAQQ TAB " ")
(RPAQQ TempCaches ((REMPROP (QUOTE Anything)
(QUOTE Examples))))
(RPAQQ UndoKill NIL)
(RPAQQ Units (IntApplics MultEleStrucInsert H29 H28 H27 H26 H25 Rarity WhyInt H24 H23 IsAInt
IntExamples LessInteresting MoreInteresting H22 Interestingness Restrictions
Extensions OpCatByNArgs PredCatByNArgs TertiaryPred UnaryPred BinaryPred
HigherArity LowerArity NonEmptyStruc EmptyStruc SetOfSets
StructureOfStructures TruthValue Atom Implies NOT LogicOp Relation
SetOfOPairs InvertOp InvertedOp Restrict Identity1 Proj3of3 Proj2of3
Proj1of3 Proj2 Proj1 MEMB MEMBER AllButLast LastEle AllButThird AllButSecond
AllButFirst ThirdEle SecondEle FirstEle ReverseOPair Pair OPair
ParallelJoin2 ParallelJoin Repeat2 TertiaryOp Repeat BinaryOp
ParallelReplace2 EachElementIsA UnaryOp TypeOfStructure ParallelReplace
Coalesce BagDifference OSetDifference ListDifference SetDifference
StrucDifference BagUnion ListUnion OSetUnion StrucUnion BagIntersect
OSetIntersect ListIntersect StrucIntersect SetUnion SetIntersect OrdStrucOp
OrdStrucEqual BagEqual ListEqual OSetEqual SufDefn NecDefn UnOrdStruc
OrdStruc NoMultEleStruc OSetDelete OSetOp OSetInsert OSet
MultEleStrucDelete1 MultEleStrucOp MultEleStruc BagDelete1 BagDelete BagOp
BagInsert Bag ListDelete1 ListDelete List ListInsert ListOp SetDelete
SetInsert StrucDelete StrucOp StrucInsert AND Abbrev Add Alg AlwaysNIL
AlwaysNIL2 AlwaysT AlwaysT2 Anything ApplicGenerator Applics Arity
BestChoose BestSubset Bit Category CompiledDefn Compose Conjecture
ConjectureAbout Conjectures ConstantBinaryPred ConstantPred
ConstantUnaryPred Creditors CriterialSlot DataType Defn DirectApplics
DivisorsOf Domain DontCopy DoubleCheck EQ EQUAL ElimSlots English EvenNum
Examples FailedRecord FailedRecordFor FastAlg FastDefn Format
Generalizations Generator GoodChoose GoodSubset H1 H10 H11 H12 H13 H14 H15
H16 H17 H18 H19 H19Criterial H2 H20 H21 H3 H4 H5 H5Criterial H5Good H6 H7 H8
H9 HAvoid HAvoid2 HAvoid2AND HAvoid3 HAvoid3First HAvoidIfWorking Heuristic
HindSightRule IEQP IGEQ IGREATERP ILEQ ILESSP IfAboutToWorkOnTask
IfFinishedWorkingOnTask IfParts IfPotentiallyRelevant IfTaskParts
IfTrulyRelevant IfWorkingOnTask InDomainOf IndirectApplics Inverse IsA
IsRangeOf IterativeAlg IterativeDefn MathConcept MathObj MathOp MathPred
Multiply NNumber NonCriterialSlot NonExamples NumOp OR OddNum Op
OverallRecord PerfNum PerfSquare Pred PrimeNum ProtoConjec RandomChoose
RandomSubset Range Record RecordFor RecordSlot RecursiveAlg RecursiveDefn
ReprConcept Set SetEqual SetOfNumbers SetOp SibSlots Slot Specializations
Square StrucEqual Structure SubSlots Subsetp SubsumedBy Subsumes Successor
SuperSlots Task TheFirstOf TheSecondOf ThenAddToAgenda
ThenAddToAgendaFailedRecord ThenAddToAgendaRecord ThenCompute
ThenComputeFailedRecord ThenComputeRecord ThenConjecture
ThenConjectureFailedRecord ThenConjectureRecord ThenDefineNewConcepts
ThenDefineNewConceptsFailedRecord ThenDefineNewConceptsRecord
ThenDeleteOldConcepts ThenDeleteOldConceptsFailedRecord
ThenDeleteOldConceptsRecord ThenModifySlots ThenModifySlotsFailedRecord
ThenModifySlotsRecord ThenParts ThenPrintToUser ThenPrintToUserFailedRecord
ThenPrintToUserRecord ToDelete ToDelete1 Transpose UnaryUnitOp Undefined
UndefinedPred Unit UnitOp UnitizedAlg UnitizedDefn Worth los1 los2 los3 los4
los5 los6 los7 win1))
(RPAQQ UnusedSlots (Alg ApplicGenerator CompiledDefn Defn DirectApplics IfParts IfTaskParts
IndirectApplics IntApplics SibSlots ThenConjectureFailedRecord
ThenDefineNewConceptsFailedRecord ThenDeleteOldConceptsFailedRecord
ThenModifySlots ThenModifySlotsFailedRecord ThenModifySlotsRecord ThenParts
ThenPrintToUserFailedRecord ToDelete WhyInt))
(RPAQQ UsedSlots (Abbrev Applics Arity ConjectureAbout Conjectures Creditors DataType Domain DontCopy
DoubleCheck EachElementIsA ElimSlots English Examples Extensions
FailedRecord FailedRecordFor FastAlg FastDefn Format Generalizations
Generator HigherArity IfAboutToWorkOnTask IfFinishedWorkingOnTask
IfPotentiallyRelevant IfTrulyRelevant IfWorkingOnTask InDomainOf IntExamples
Interestingness Inverse IsA IsAInt IsRangeOf IterativeAlg IterativeDefn
LessInteresting LowerArity MoreInteresting NecDefn NonExamples OverallRecord
Range Rarity Record RecordFor RecursiveAlg RecursiveDefn Restrictions
Specializations SubSlots SubsumedBy Subsumes SufDefn SuperSlots
ThenAddToAgenda ThenAddToAgendaFailedRecord ThenAddToAgendaRecord
ThenCompute ThenComputeFailedRecord ThenComputeRecord ThenConjecture
ThenConjectureRecord ThenDefineNewConcepts ThenDefineNewConceptsRecord
ThenDeleteOldConcepts ThenDeleteOldConceptsRecord ThenPrintToUser
ThenPrintToUserRecord ToDelete1 Transpose UnitizedAlg UnitizedDefn Worth))
(RPAQQ UserImpatience 1)
(RPAQQ Verbosity 67)
(RPAQQ ZZ NIL)
(RPAQ FONTCHANGEFLG NIL)
(RPAQ CHANGESARRAY NIL)
(RPAQ PROMPT#FLG T)
(RPAQQ EURFNS (APPLYEVAL AddInv AddNN AddPropL Alg AllPairs ApplicArgs ApplicGenArgs ApplicGenBuild
ApplicGenInit Apply-to-u ApplyAlg ApplyDefn ApplyRule Average AverageWorths
BestChoose BestSubset CPRIN1 CacheExamples Certainty Check2AfterEditp
CheckAfterEditp CheckElim CheckTheValues Comp ConsNN CreateUnit CurSup
CycleThruAgenda Date2 DecrementCreditAssignment DefineIfSlot DefineSlot Defn
DirectApplics Divides DoesIntersect DreplaceGet DwimUnionProp EU EVERY2
EqualToWithinSubst Eurisko Examples ExtractInput ExtractOutput
ExtractPriority ExtractReasons ExtractSlotName ExtractUnitName FavorFirst
FirstTwo Flatten FractionOf GatherExamples GenArgs GenBuild GenInit
Generalizations Generalize1LispExpr Generalize1LispFn Generalize1LispPred
GeneralizeBit GeneralizeCompiledLispCode GeneralizeDataType
GeneralizeDottedPair GeneralizeIOPair GeneralizeLispFn GeneralizeLispPred
GeneralizeList GeneralizeNIL GeneralizeNumber GeneralizeSlot GeneralizeText
GeneralizeUnit GetABag GetAList GetAOPair GetAOSet GetASet GetAStruc
GoodChoose GoodSubset Half HasHighWorth ISQRT IndirectApplics
InitialCheckInv InitialElimSlots InitializeCreditAssignment
InitializeEurisko InsideOf Instances Interestingness Interp1 Interp2 Interp2
Interp3 Interrupts IsAKindOf IsAlto IsSubsetOf KillSlot KillUnit KnownApplic
LEQNN LessWorth ListifyIfNec ListsStarting ListsStartingAux MAP2EVERY
MAPAPPEND MAXIMUM MAXIMUM2 Map&Print MapApplics MapExamples MapUnion
MergeProps MergeTasks MoreSpecific MostSpecific MyTime NU NUnitp NearnessTo
NewNam NoRepeatsIn OKBinPreds OrderTasks PRINBOL PRINTASK PU PU2 Percentify
PunishSeverely Quoted REM1PROP RandomChoose RandomP RandomPair RandomSubset
RandomSubst RandomSubst* RepeatsIn ReportOn ResetPri RuleTakingTooLong
RunAlg RunDefn SOME1 SOS SQUARE START SelfIntersect SetDiff SetDifference
SetIntersect SetUnion Shorten SibSlots Sibs SlotNames SlotSubst Slotp
SmartPACK* Snazzy SnazzyAgenda SnazzyConcept SnazzyHeuristic SnazzyTask
SomeOPair SomePair SomeUneliminated SortByWorths Specializations
Specialize1LispExpr Specialize1LispFn Specialize1LispPred SpecializeBit
SpecializeCompiledLispCode SpecializeDataType SpecializeDottedPair
SpecializeIOPair SpecializeLispFn SpecializeLispPred SpecializeList
SpecializeNIL SpecializeNumber SpecializeSlot SpecializeText SpecializeUnit
StrongUnsaveDef TakingTooLong TakingTooMuchSpace TheFirstOf TheNumberOf
TheSecondOf TinyReward TrueIfItExists UnGet UnionProp UnionPropL Unitp WaxOn
WholeTask WorkOnTask WorkOnTask WorkOnUnit WorkOnUnit WorthWorkingOn
XeqIfItExists YesNo ZeroRecords))
(DEFINEQ
(APPLYEVAL
[LAMBDA (F ARGL) (* edited: " 4-MAR-81 12:43")
(EVAL (CONS F ARGL])
(AddInv
[LAMBDA (un) (* edited: "28-APR-81 01:49")
(MAP2C (GETPROPLIST un)
(CDR (GETPROPLIST un))
[FUNCTION (LAMBDA (pr val inv)
(AND (SETQ inv (CAR (Inverse pr)))
(MAPC val (FUNCTION (LAMBDA (e)
(DwimUnionProp e inv un]
(QUOTE CDDR))
un])
(AddNN
[LAMBDA (x y) (* edited: "27-APR-81 15:31")
(PLUS (OR x 0)
(OR y 0])
(AddPropL
[LAMBDA (L P V) (* edited: "24-Feb-81 22:10")
(* Like ADDPROP, but works for LISTS)
(COND
((ASSOC P L)
(NCONC1 (ASSOC P L)
V)
L)
(L (NCONC1 L (LIST P V)))
(T (LIST (LIST P V])
(Alg
[LAMBDA (u) (* edited: "25-APR-81 11:22")
(OR (GETPROP u (QUOTE Alg))
(SOME1 (SubSlots (QUOTE Alg))
(FUNCTION (LAMBDA (s)
(APPLY* s u])
(AllPairs
[LAMBDA (L Rel v) (* edited: "24-Apr-81 02:13")
(for ip from 1 to (LENGTH L) as ii in L join (for jp from 1 to (LENGTH L) as jj in L
join (COND
((EQ ip jp)
NIL)
((SETQ v (APPLY* Rel ii jj))
(LIST (LIST ip jp ii jj v])
(ApplicArgs
[LAMBDA (X) (* edited: " 4-MAR-81 13:26")
(CAR X])
(ApplicGenArgs
[LAMBDA (X) (* edited: " 4-MAR-81 13:44")
(CADDR X])
(ApplicGenBuild
[LAMBDA (X) (* edited: " 4-MAR-81 13:43")
(CADR X])
(ApplicGenInit
[LAMBDA (X) (* edited: " 4-MAR-81 13:43")
(CAR X])
(Apply-to-u
[LAMBDA (s) (* edited: "11-MAR-81 11:58")
(APPLY* s u])
(ApplyAlg
[LAMBDA (f args) (* edited: "27-APR-81 22:15")
(APPLY (QUOTE RunAlg)
(CONS f args])
(ApplyDefn
[LAMBDA (u args) (* edited: "27-APR-81 22:15")
(APPLY (QUOTE RunDefn)
(CONS u args])
(ApplyRule
[LAMBDA (r u msg tau) (* edited: "20-Mar-81 00:46")
(* Unfortuantely, this doesn't check the
value of AbortTask...)
(SETQ tau ArgU)
(SETQ ArgU u)
(PROG1 (AND (CPRIN1 75 CRLF " Rule " r (Abbrev r)
" is being applied to " C (OR msg " ")
CRLF)
(EVERY (SubSlots (QUOTE ThenParts))
(QUOTE XeqIfItExists))
(CPRIN1 75 " The Then Parts of the rule have been executed.
" CRLF))
(SETQ ArgU tau])
(Average
[LAMBDA (N M) (* edited: "23-FEB-81 14:07")
(QUOTIENT (PLUS N M 1)
2])
(AverageWorths
[LAMBDA (u v) (* edited: "31-Mar-81 21:11")
(QUOTIENT (PLUS (OR (Worth u)
0)
(OR (Worth v)
0))
2])
(BestChoose
[LAMBDA (L) (* edited: "25-MAR-81 12:17")
[AND (LITATOM L)
(MEMB (QUOTE Set)
(IsA L))
(SETQ L (OR (Examples L)
(GatherExamples L]
(MAXIMUM (SUBSET L (QUOTE Unitp))
(QUOTE Worth])
(BestSubset
[LAMBDA (L) (* edited: "25-MAR-81 12:18")
[AND (LITATOM L)
(MEMB (QUOTE Set)
(IsA L))
(SETQ L (OR (Examples L)
(GatherExamples L]
(DREVERSE (NTH (SortByWorths (APPEND L))
(RAND 1 (LENGTH L])
(CPRIN1
[LAMBDA CprinX (* edited: "28-FEB-81 18:57")
[COND
((IGREATERP Verbosity (ARG CprinX 1))
(SETQ cprintmp 1)
(RPTQ (SUB1 CprinX)
(PRIN1 (ARG CprinX (SETQ cprintmp (ADD1 cprintmp)))
TTY]
T])
(CacheExamples
[LAMBDA (u) (* edited: " 1-APR-81 12:33")
(OR (GETPROP u (QUOTE Examples))
(PUT u (QUOTE Examples)
(GatherExamples u])
(Certainty
[LAMBDA (N) (* edited: "15-FEB-81 17:23")
(COND
((ILESSP N 100)
(QUOTE Inconceivable))
((ILESSP N 400)
(QUOTE Unlikely))
((ILESSP N 600)
(QUOTE Possible))
((ILESSP N 800)
(QUOTE Probable))
(T (QUOTE AlmostCertain])
(Check2AfterEditp
[LAMBDA (oldprop oldval invprop) (* edited: "23-FEB-81 18:55")
(AND (Inverse oldprop)
(NULL (APPLY* oldprop (CAR EDITPX)))
(SETQ invprop (CAR (Inverse oldprop)))
(MAPC oldval (FUNCTION (LAMBDA (e)
(REM1PROP e invprop (CAR EDITPX])
(CheckAfterEditp
[LAMBDA (prop val old invprop) (* edited: "27-Feb-81 19:43")
(AND (SETQ invprop (CAR (Inverse prop)))
(PROGN [MAPC (SetDiff val (SETQ old (LISTGET EditpTemp prop)))
(FUNCTION (LAMBDA (e)
(DwimUnionProp e invprop (CAR EDITPX]
(MAPC (SetDiff old val)
(FUNCTION (LAMBDA (e)
(REM1PROP e invprop (CAR EDITPX])
(CheckElim
[LAMBDA NIL (* edited: "18-MAR-81 11:50")
(AND (YesNo NIL "Should I eliminate recently-computed values? ")
(MAPC Units (QUOTE InitialElimSlots])
(CheckTheValues
[LAMBDA (u s v) (* edited: " 2-MAR-81 18:40")
(* doublecheck that all the values on v
are legitimate entries for the s slot of
u)
T])
(Comp
[LAMBDA (F D SaveExpr?) (* edited: "19-MAR-81 13:22")
(RESETVARS (LAPFLG STRF SVFLG LCFIL LSTFIL)
(SETQ STRF T)
(SETQ SVFLG SaveExpr?)
(COMPILE1 F D))
(COND
(SaveExpr? F)
(T (REMPROP F (QUOTE EXPR])
(ConsNN
[LAMBDA (x l) (* edited: "26-APR-81 18:57")
(COND
(x (CONS x l))
(T l])
(CreateUnit
[LAMBDA (N NOLD) (* edited: "15-APR-81 17:51")
(PROG1 (COND
((NOT (ATOM N))
(WARNING (CONS "Must be atomic unit name! You typed: " N)))
((MEMB N Units)
(CreateUnit (NewNam N)
NOLD))
((MEMB NOLD Units)
(SETQ Units (CONS N Units))
(SETQ NewU (CONS N NewU))
[SETPROPLIST N (MergeProps (APPEND (GETPROPLIST N))
(SlotSubst N NOLD (GETPROPLIST NOLD]
[MAPC (PROPNAMES N)
(FUNCTION (LAMBDA (P)
(COND
((DontCopy P)
(REMPROP N P))
((DoubleCheck P)
(CheckTheValues N P (APPLY* P N]
(AddInv N)
N)
(T (SETQ Units (CONS N Units))
(SETQ NewU (CONS N NewU))
(PUT N (QUOTE Worth)
500)
N))
(DefineIfSlot N)
(AND (GETD NOLD)
(NOT (GETD N))
(MOVD NOLD N T)
(SETQ MoveDefns (CONS (LIST (QUOTE MOVD)
(KWOTE NOLD)
(KWOTE N)
T)
MoveDefns])
(CurSup
[LAMBDA (ESA) (* edited: "23-FEB-81 13:36")
(CAR (CDDDDR ESA])
(CycleThruAgenda
[LAMBDA NIL (* edited: "15-FEB-81 16:25")
(PROG (task)
TLOOP
(COND
(Agenda (SETQ task (CAR Agenda))
(SETQ Agenda (CDR Agenda))
(WorkOnTask task) (* Note that this might add/change the
Agenda)
T)
(T (RETURN NIL)))
(GO TLOOP])
(Date2
[LAMBDA (day mon temp dat) (* edited: " 1-APR-81 13:31")
(SETQ dat (UNPACK (DATE)))
(SETQ temp (MEMB (QUOTE -)
dat))
[SETQ day (PACK (REMOVE (QUOTE % )
(LDIFF dat temp]
[SETQ mon (PACK (LDIFF (CDR temp)
(MEMB (QUOTE -)
(CDR temp]
(PACK* mon day])
(DecrementCreditAssignment
[LAMBDA NIL (* edited: "23-FEB-81 16:49")
(SETQ GCredit (ADD1 GCredit])
(DefineIfSlot
[LAMBDA (s) (* edited: "23-Mar-81 16:45")
(AND (Slotp s)
(NULL (GETD s))
(SETQ Slots (CONS s Slots))
(DefineSlot s))
s])
(DefineSlot
[LAMBDA (s) (* edited: " 2-MAR-81 14:17")
(* Really this should doublecheck that s
isa slot)
(COND
((CCODEP s) (* s already has a definition)
s)
((EXPRP s)
(Comp s (GETD s)
T))
(T [PUTD s (LIST (QUOTE LAMBDA)
(LIST (QUOTE u))
(LIST (QUOTE GETPROP)
(QUOTE u)
(KWOTE s]
(Comp s (GETD s])
(Defn
[LAMBDA (u) (* edited: "15-APR-81 17:54")
(OR (GETPROP u (QUOTE Defn))
[SOME1 (SubSlots (QUOTE Defn))
(FUNCTION (LAMBDA (s)
(APPLY* s u]
(AND (IsA u (QUOTE Category))
(SUBST u (QUOTE u)
(QUOTE (LAMBDA (z)
(MEMB (QUOTE u)
(IsA z])
(DirectApplics
[LAMBDA (u) (* edited: " 7-Mar-81 14:55")
(SUBSET (Applics u)
(FUNCTION (LAMBDA (A)
(MEMB (CADDR A)
(QUOTE (NIL 1])
(Divides
[LAMBDA (A B) (* edited: " 2-MAR-81 15:58")
(ZEROP (REMAINDER B A])
(DoesIntersect
[LAMBDA (L M) (* edited: "23-Mar-81 16:47")
(SOME L (FUNCTION (LAMBDA (Z)
(MEMB Z M])
(DreplaceGet
[LAMBDA (L) (* edited: " 2-MAR-81 11:37")
(COND
((Quoted (CADDR L))
(RPLACA L (CADR (CADDR L)))
(RPLACD (CDR L)
NIL)
L)
(T (RPLACA L (CADDR L))
(RPLACD (CDR L)
NIL)
(ATTACH (QUOTE APPLY*)
L])
(DwimUnionProp
[LAMBDA (A P V flag tmp8) (* edited: " 2-APR-81 13:44")
(COND
((Unitp A)
(UnionProp A P V flag))
((FMEMB A SpecialNonUnits)
(CPRIN1 50 CRLF A " isn't a unit, but it has an excuse, so we'll let it slide. " CRLF))
[(LITATOM A)
(PRIN1 (CONS A (QUOTE (is not yet a unit; make it one?)))
TTY)
(AND (YesNo)
(UnionProp A P V flag)
(PUTPROP A (QUOTE IsA)
(LIST (QUOTE Slot)))
(UnionProp (QUOTE Slot)
(QUOTE Examples)
A)
(NU A (AND (Inverse P)
(Unitp V)
[SETQ tmp8 (CAR (SOME (APPLY* (CAR (Inverse P))
V)
(QUOTE Unitp]
(PRIN1 " ... Copying from " TTY)
(PRIN1 tmp8 TTY)
(PRIN1 CRLF TTY)
tmp8]
(T NIL])
(EU
[NLAMBDA EDITPX (* edited: " 2-MAR-81 16:38")
(COND
((COND
((Unitp (CAR EDITPX))
(SETQ LastEdited EDITPX))
(EDITPX (PRIN1 "EU complaining: not an existing unit name! ")
(TERPRI)
(PRIN1 "What did you really mean to type? ")
(APPLY* (QUOTE EU)
(RATOM TTY))
NIL)
((SETQ EDITPX LastEdited)
(PRIN1 "=" TTY)
(PRIN1 (CAR EDITPX)
TTY)
(TERPRI)
T)
(T NIL))
[SETQ EditpTemp (COPY (GETPROPLIST (CAR EDITPX]
(EVAL (CONS (QUOTE EDITP)
EDITPX))
(MAP2C (GETPROPLIST (CAR EDITPX))
(CDR (GETPROPLIST (CAR EDITPX)))
(FUNCTION CheckAfterEditp)
(QUOTE CDDR))
(MAP2C EditpTemp (CDR EditpTemp)
(FUNCTION Check2AfterEditp)
(QUOTE CDDR))
(CONS (QUOTE FinishedEditing)
EDITPX))
(T NIL])
(EVERY2
[LAMBDA (L M F) (* edited: "15-APR-81 15:30")
(COND
((NLISTP L)
T)
((NLISTP M)
T)
((APPLY* F (CAR L)
(CAR M))
(EVERY2 (CDR L)
(CDR M)
F])
(EqualToWithinSubst
[LAMBDA (C1 C2 V1 V2) (* edited: "27-MAR-81 13:20")
(* Is the value of V1 and V2 equal to
within substing C2 for C1 ?)
(COND
((EQ V1 V2))
((NEQ (LENGTH V1)
(LENGTH V2))
NIL)
((EQUAL V1 V2))
((EQUAL V2 (SUBST C2 C1 V1)))
(T NIL])
(Eurisko
[LAMBDA (Verbo EternalFlg) (* edited: " 4-MAR-81 12:06")
(COND
((FIXP Verbo)
(SETQ Verbosity Verbo))
(T NIL))
(PRIN1 "
Starting EURISKO
Douglas B. Lenat
February, 1981
")
(InitializeEurisko)
(SETQ TaskNum 0)
(CPRIN1 -1 CRLF "Ready to start? ")
(COND
((YesNo)
(START EternalFlg))
(T "Type (START) when you are ready."])
(Examples
[LAMBDA (u LookedThru) (* edited: "26-APR-81 19:12")
(OR (GETPROP u (QUOTE Examples))
(COND
((MEMB u LookedThru)
NIL)
((SETQ LookedThru (CONS u LookedThru))
(MapUnion (Specializations u)
(FUNCTION (LAMBDA (SU)
(Examples SU LookedThru])
(ExtractInput
[LAMBDA (X) (* edited: " 5-MAR-81 17:04")
(CAR X])
(ExtractOutput
[LAMBDA (X) (* edited: " 5-MAR-81 17:05")
(CADR X])
(ExtractPriority
[LAMBDA (ESA) (* edited: "23-FEB-81 14:01")
(CAR ESA])
(ExtractReasons
[LAMBDA (ESA) (* edited: "23-FEB-81 13:35")
(CADDDR ESA])
(ExtractSlotName
[LAMBDA (ESA) (* edited: "23-FEB-81 13:35")
(CADDR ESA])
(ExtractUnitName
[LAMBDA (task) (* edited: "15-FEB-81 16:39")
(CADR task])
(FavorFirst
[LAMBDA (A B) (* edited: "26-APR-81 16:23")
(COND
((ZEROP (RAND 0 45))
(EVAL B))
(T (EVAL A])
(FirstTwo
[LAMBDA (L) (* edited: "24-Apr-81 04:06")
(LIST (CAR L)
(CADR L])
(Flatten
[LAMBDA (L) (* edited: "23-FEB-81 17:25")
(COND
((NULL L)
NIL)
((ATOM L)
(LIST L))
(T (MAPCONC L (QUOTE Flatten])
(FractionOf
[LAMBDA (L P) (* edited: "24-FEB-81 18:39")
(* compute the fraction of entries on L
which satisfy predicate P)
(COND
((ATOM L)
0)
(T (QUOTIENT (FLOAT (LENGTH (SUBSET L P)))
(FLOAT (LENGTH L])
(GatherExamples
[LAMBDA (u LookedThru) (* edited: "25-MAR-81 11:30")
(OR (GETPROP u (QUOTE Examples))
(COND
((MEMB u LookedThru)
NIL)
((SETQ LookedThru (CONS u LookedThru))
(MapUnion (Specializations u)
(FUNCTION (LAMBDA (SU)
(GatherExamples SU LookedThru])
(GenArgs
[LAMBDA (X) (* edited: " 4-MAR-81 12:15")
(CADDR X])
(GenBuild
[LAMBDA (X) (* edited: " 4-MAR-81 12:15")
(CADR X])
(GenInit
[LAMBDA (X) (* edited: " 4-MAR-81 12:15")
(CAR X])
(Generalizations
[LAMBDA (u) (* edited: "19-FEB-81 16:36")
(SelfIntersect (NCONC [MAPCONC (GETPROP (QUOTE Generalizations)
(QUOTE SubSlots))
(FUNCTION (LAMBDA (ss)
(APPEND (GETPROP u ss]
(GETPROP u (QUOTE Generalizations])
(Generalize1LispExpr
[LAMBDA (bod tmp tmp2 fbod) (* edited: "25-MAR-81 12:34")
(* AreUnits is the list of units mentioned
in bod ; HaveGenl are those which have
specializations already)
(COND
([SETQ tmp2 (RandomChoose (Generalizations
(SETQ tmp (RandomChoose
(SETQ HaveGenl (UNION (SUBSET (SETQ AreUnits
(SUBSET (SETQ fbod
(SelfIntersect
(Flatten bod)))
(QUOTE Unitp)))
(QUOTE Generalizations))
HaveGenl]
(SETQ UDiff (LIST tmp RArrow tmp2))
(RandomSubst tmp2 tmp bod))
([SETQ tmp2 (GeneralizeNumber (SETQ tmp (RandomChoose (SUBSET (SelfIntersect fbod)
(QUOTE NUMBERP]
(SETQ UDiff (LIST tmp RArrow tmp2))
(RandomSubst tmp2 tmp bod))
(T bod])
(Generalize1LispFn
[LAMBDA (bod) (* edited: "25-MAR-81 12:32")
(Generalize1LispExpr bod])
(Generalize1LispPred
[LAMBDA (bod tmp tmp2) (* edited: "25-MAR-81 12:33")
(Generalize1LispExpr bod])
(GeneralizeBit
[LAMBDA (b) (* edited: "28-Feb-81 17:22")
(NOT b])
(GeneralizeCompiledLispCode
[LAMBDA (X) (* edited: " 4-MAR-81 16:08")
X])
(GeneralizeDataType
[LAMBDA (x tmp) (* edited: "25-MAR-81 12:39")
(COND
[(LISTP x)
(MAPCAR x (FUNCTION (LAMBDA (Z)
(COND
((RandomP)
(GeneralizeDataType Z))
(T Z]
((SETQ tmp (RandomChoose (Generalizations x)))
(SETQ UDiff (LIST x RArrow tmp))
tmp)
(T x])
(GeneralizeDottedPair
[LAMBDA (x) (* edited: " 1-APR-81 14:36")
x])
(GeneralizeIOPair
[LAMBDA (x) (* edited: " 2-MAR-81 18:20")
(* eventually: look thru the (i o) pairs, and make a few new ones, with i's
selected from the set of i's, and o's similarly -- or select from examples of
things which i and o are examples of)
x])
(GeneralizeLispFn
[LAMBDA (x) (* edited: " 3-Apr-81 00:34")
(* presumed to be given either the name of
a predicate, or a list of the form
(LAMBDA --))
(COND
((NUMBERP x)
(GeneralizeNumber x))
((LITATOM x)
(COND
[(Generalizations x)
(CADDR (SETQ UDiff (LIST x RArrow (RandomChoose (Generalizations x]
(T x)))
((NLISTP x)
x)
[(LISTP (CAR x))
(MAPCAR x (FUNCTION (LAMBDA (Z)
(COND
((RandomP)
(GeneralizeLispFn Z))
(T Z]
[(EQ (CAR x)
(QUOTE LAMBDA))
(CONS (QUOTE LAMBDA)
(CONS (CADR x)
(MAPCAR (CDDR x)
(QUOTE Generalize1LispFn]
(T x])
(GeneralizeLispPred
[LAMBDA (x) (* edited: " 3-Apr-81 00:34")
(* presumed to be given either the name of
a predicate, or a list of the form
(LAMBDA --))
(COND
((NUMBERP x)
(GeneralizeNumber x))
((LITATOM x)
(COND
[(Generalizations x)
(CADDR (SETQ UDiff (LIST x RArrow (RandomChoose (Generalizations x]
(T x)))
((NLISTP x)
x)
[(LISTP (CAR x))
(MAPCAR x (FUNCTION (LAMBDA (Z)
(COND
((RandomP)
(GeneralizeLispPred Z))
(T Z]
[(EQ (CAR x)
(QUOTE LAMBDA))
(CONS (QUOTE LAMBDA)
(CONS (CADR x)
(MAPCAR (CDDR x)
(QUOTE Generalize1LispPred]
(T x])
(GeneralizeList
[LAMBDA (x) (* edited: "25-MAR-81 12:46")
(COND
[(LISTP (CAR x))
(MAPCAR x (FUNCTION (LAMBDA (Z)
(COND
((RandomP)
(GeneralizeList Z))
(T Z]
(T (SETQ UDiff (LIST (QUOTE Duplicated:)))
(SORT (APPEND [SUBSET x (FUNCTION (LAMBDA (R)
(COND
((RandomP)
(NCONC1 UDiff R)
NIL)
(T T]
x)
(QUOTE RandomP])
(GeneralizeNIL
[LAMBDA (X) (* edited: "25-MAR-81 12:43")
(WARNING (CONS X " can't be generalized if it doesn't have a known DataType! "])
(GeneralizeNumber
[LAMBDA (x) (* edited: "25-MAR-81 12:31")
(COND
[(LISTP x)
(MAPCAR x (FUNCTION (LAMBDA (Z)
(COND
((RandomP)
(GeneralizeNumber Z))
(T Z]
[(FIXP x)
(CADDR (SETQ UDiff (LIST x RArrow (RAND x (COND
((ILEQ x 1000)
1000)
(T (TIMES x 10]
[(NUMBERP x)
(CADDR (SETQ UDiff (LIST x RArrow (QUOTIENT (RAND (FIX (TIMES x 200))
(FIX (TIMES x (MAX 5.0 x)
200)))
200.0]
(T NIL])
(GeneralizeSlot
[LAMBDA (x tmp) (* edited: "25-MAR-81 12:44")
(COND
[(LISTP x)
(MAPCAR x (FUNCTION (LAMBDA (Z)
(COND
((RandomP)
(GeneralizeSlot Z))
(T Z]
((SETQ tmp (RandomChoose (Generalizations x)))
(SETQ UDiff (LIST x RArrow tmp))
tmp)
(T x])
(GeneralizeText
[LAMBDA (x) (* edited: "25-MAR-81 12:46")
(COND
[(LISTP (CAR x))
(MAPCAR x (FUNCTION (LAMBDA (Z)
(COND
((RandomP)
(GeneralizeText Z))
(T Z]
(T (SETQ UDiff (LIST (QUOTE Duplicated:)))
(SORT (APPEND [SUBSET x (FUNCTION (LAMBDA (R)
(COND
((RandomP)
(NCONC1 UDiff R)
NIL)
(T T]
x)
(QUOTE RandomP])
(GeneralizeUnit
[LAMBDA (x tmp) (* edited: "25-MAR-81 12:47")
(COND
[(LISTP x)
(MAPCAR x (FUNCTION (LAMBDA (Z)
(COND
((RandomP)
(GeneralizeUnit Z))
(T Z]
((SETQ tmp (RandomChoose (Generalizations x)))
(SETQ UDiff (LIST x RArrow tmp))
tmp)
(T x])
(GetABag
[LAMBDA (ov) (* edited: "22-APR-81 15:15")
(GetAList ov])
(GetAList
[LAMBDA (ov) (* edited: "22-APR-81 15:15")
(for i from 0 to (RAND 0 (SQUARE (RAND 1 10))) collect (FavorFirst
[QUOTE (RandomChoose
(CacheExamples (QUOTE Anything]
(QUOTE (GetAStruc])
(GetAOPair
[LAMBDA (ov) (* edited: "26-APR-81 15:58")
(FirstTwo (GetAList ov])
(GetAOSet
[LAMBDA (ov) (* edited: "22-APR-81 15:15")
(SelfIntersect (GetAList ov])
(GetASet
[LAMBDA (ov) (* edited: "22-APR-81 15:15")
(SelfIntersect (GetAList ov])
(GetAStruc
[LAMBDA (ov f) (* edited: "22-APR-81 13:23")
(COND
([GETD (SETQ f (PACK* (QUOTE GetA)
(RandomChoose (GETPROP (QUOTE Structure)
(QUOTE Specializations]
(APPLY* f ov))
(T (GetAStruc ov])
(GoodChoose
[LAMBDA (L) (* edited: "25-MAR-81 12:19")
[AND (LITATOM L)
(MEMB (QUOTE Set)
(IsA L))
(SETQ L (OR (Examples L)
(GatherExamples L]
(CAR (SOME (SortByWorths (APPEND L))
(QUOTE RandomP])
(GoodSubset
[LAMBDA (L) (* edited: "25-MAR-81 12:18")
(RandomSubset (BestSubset L])
(Half
[LAMBDA (n) (* edited: "18-MAR-81 13:38")
(IQUOTIENT n 2])
(HasHighWorth
[LAMBDA (u) (* edited: "15-FEB-81 13:48")
(AND (Unitp u)
(GREATERP (Worth u)
800])
(ISQRT
[LAMBDA (N) (* edited: " 4-MAR-81 15:32")
(FIX (SQRT N])
(IndirectApplics
[LAMBDA (u) (* edited: " 7-Mar-81 14:55")
(SUBSET (Applics u)
(FUNCTION (LAMBDA (A)
(NOT (MEMB (CADDR A)
(QUOTE (NIL 1])
(InitialCheckInv
[LAMBDA (uns BogusU) (* edited: "28-APR-81 01:56")
[AND (YesNo NIL "Shall I ferret out nonunits referred to by honest, true units? ")
(Map&Print (COND
((NULL uns)
Units)
((LITATOM uns)
(LIST uns))
((LISTP uns)
uns)
(T NIL))
(FUNCTION (LAMBDA (un MustRem)
(MAP2C (GETPROPLIST un)
(CDR (GETPROPLIST un))
[FUNCTION (LAMBDA (pr val inv)
(AND (SETQ inv (CAR (Inverse pr)))
(MAPC val (FUNCTION (LAMBDA (e)
(OR (Unitp e)
(NOT (LITATOM e))
(NOT (MEMB (QUOTE -)
(UNPACK e)))
(PROGN (CPRIN1 2 CRLF e " mentioned by " un)
(SETQ MustRem
(CONS (LIST un pr e)
MustRem))
(SETQ BogusU (CONS e BogusU]
(QUOTE CDDR))
[MAPC MustRem (FUNCTION (LAMBDA (L)
(APPLY (QUOTE REM1PROP)
L]
un]
(CPRIN1 -2 CRLF "Finished ferreting out non-units. Ready to add all inverse pointers? ")
(AND (YesNo)
(Map&Print Units (QUOTE AddInv)))
(CPRIN1 -2 CRLF
"OK. Do you want me to zero out all the time/calling records of all the heuristics?")
(AND (YesNo)
(Map&Print (Examples (QUOTE Heuristic))
(QUOTE ZeroRecords)))
BogusU])
(InitialElimSlots
[LAMBDA (u) (* edited: " 4-MAR-81 16:41")
[MAPC SlotsToElimInitially (FUNCTION (LAMBDA (s)
(REMPROP u s]
(MAPC (ElimSlots u)
(FUNCTION (LAMBDA (s)
(REMPROP u s])
(InitializeCreditAssignment
[LAMBDA NIL (* edited: "23-FEB-81 16:49")
(SETQ GCredit 1])
(InitializeEurisko
[LAMBDA (doit) (* edited: "15-APR-81 13:50")
(Interrupts)
[COND
[(OR doit (YesNo NIL "Fully Initialize? "))
(PRIN1 "OK, defining Slots, UsedSlots, UnusedSlots, NUnitSlots as I go along... " TTY)
(SETQ Agenda NIL)
(SETQ Conjectures NIL)
(SETQ UnusedSlots NIL)
(SETQ UsedSlots NIL)
[MAPC Units (FUNCTION (LAMBDA (U)
(MAPC (PROPNAMES U)
(FUNCTION (LAMBDA (SL)
(OR (MEMB SL UsedSlots)
(MEMB SL SYSPROPS)
(PROGN (SETQ UsedSlots (CONS SL UsedSlots))
(DefineSlot SL]
[MAPC Units (FUNCTION (LAMBDA (u)
(AND (MEMB (QUOTE Slot)
(IsA u))
(NOT (MEMB u UsedSlots))
(SETQ UnusedSlots (CONS u UnusedSlots))
(DefineSlot u]
(SETQ UsedSlots (SORT UsedSlots))
(SETQ UnusedSlots (SORT UnusedSlots))
(MAPC UnusedSlots (QUOTE DefineSlot))
(PRIN1 "Done! " TTY)
(PRIN1 (LIST [LENGTH (SETQ Slots (MERGE (APPEND UsedSlots)
(APPEND UnusedSlots]
(QUOTE Slots))
TTY)
[AND (SETQ NUnitSlots (SUBSET Slots (QUOTE NUnitp)))
(YesNo NIL (CONCAT (LENGTH NUnitSlots)
" slots aren't defined as units. Do that now? "))
(MAPC (APPEND NUnitSlots)
(FUNCTION (LAMBDA (Z)
(TERPRI TTY)
(PRINT Z TTY)
(NU Z (QUOTE Abbrev))
(SETQ NUnitSlots (DREMOVE Z NUnitSlots]
(AND NewU (CPRIN1 -1 CRLF "Eliminate the recently synthesized units? ")
(CPRIN1 20 NewU)
(YesNo)
(Map&Print (COPY NewU)
(QUOTE KillUnit)))
(AND (SomeUneliminated)
(CPRIN1 -1 CRLF
"Eliminate the individual values filled in during an earlier run, for slots of units still in existence? "
)
(YesNo)
(MAPC Units (QUOTE InitialElimSlots]
(T (PRIN1 " OK, just initializing the slot definitions. " TTY)
(TERPRI TTY)
[MAPC Units (FUNCTION (LAMBDA (U)
(MAPC (PROPNAMES U)
(FUNCTION (LAMBDA (SL)
(OR (MEMB SL SYSPROPS)
(DefineSlot SL]
(MAPC Units (FUNCTION (LAMBDA (u)
(AND (MEMB (QUOTE Slot)
(IsA u))
(DefineSlot u]
(CPRIN1 20 CRLF "There are " (LENGTH Units)
" units, of which "
(LENGTH SynthU)
" were synthesized by Eurisko." CRLF)
(CPRIN1 21 "Of those, " CRLF)
(ReportOn (QUOTE (Heuristic MathOp MathObj ReprConcept))
21)
(CPRIN1 20 CRLF)
(QUOTE !])
(InsideOf
[LAMBDA (X L) (* edited: " 2-MAR-81 11:19")
(COND
((NULL L)
NIL)
((EQ X L)
T)
[(LISTP L)
(OR (InsideOf X (CAR L))
(InsideOf X (CDR L]
(T NIL])
(Instances
[LAMBDA (u) (* edited: " 7-Mar-81 15:42")
(COND
((MEMB (QUOTE Heuristic)
(IsA u))
(QUOTE Applics))
((MEMB (QUOTE Op)
(IsA u))
(QUOTE Applics))
(T (QUOTE Examples])
(Interestingness
[LAMBDA (u LookedThru) (* edited: "30-Apr-81 23:29")
(COND
((MEMB u LookedThru)
NIL)
[(CDR (SETQ LookedThru (CONS u LookedThru)))
(ConsNN (GETPROP u (QUOTE Interestingness))
(MapUnion (Generalizations u)
(FUNCTION (LAMBDA (SU)
(Interestingness SU LookedThru]
([SETQ LookedThru (ConsNN (GETPROP u (QUOTE Interestingness))
(MapUnion (Generalizations u)
(FUNCTION (LAMBDA (SU)
(Interestingness SU LookedThru]
(* this must be the initial call)
(LIST (QUOTE LAMBDA)
(QUOTE (u))
(CONS (QUOTE OR)
LookedThru)))
(T (* There were no Interestingness
predicates aywhere along my ancestry)
NIL])
(Interp1
[LAMBDA (r ArgU) (* edited: "15-FEB-81 14:13")
(* assembles pieces of the heuristic rule
r, and runs them on argument ArgU)
(COND
((EVERY (SubSlots (QUOTE IfParts))
(QUOTE TrueIfItExists)))
(T NIL])
(Interp2
[LAMBDA (r ArgU) (* edited: "18-MAY-81 14:06")
(* assembles pieces of the heuristic rule
r, and runs them on argument ArgU)
(* This is a more "vocal" interpeter than
interp1)
(COND
((EVERY (SubSlots (QUOTE IfParts))
(QUOTE TrueIfItExists))
(AND (IsAlto)
(SnazzyHeuristic r))
(COND
((IGREATERP Verbosity 66)
(PRIN1 " All the IfParts of ")
(PRIN1 r)
(PRIN1 (Abbrev r))
(PRIN1 " are satisfied, so we are applying the ThenParts. ")
(TERPRI))
((IGREATERP Verbosity 29)
(PRIN1 r)
(PRIN1 " applies. ")
(TERPRI)))
(AND (MyTime (QUOTE (EVERY (SubSlots (QUOTE ThenParts))
(QUOTE XeqIfItExists)))
(QUOTE TimeThen))
(CPRIN1 68 CRLF " All the ThenParts of " r (Abbrev r)
" have been successfully executed. " CRLF)
[SETQ TimRec (OR (OverallRecord r)
(PUT r (QUOTE OverallRecord)
(CONS 0 0]
(RPLACD TimRec (ADD1 (CDR TimRec)))
(RPLACA TimRec (IPLUS (CAR TimRec)
TimeThen))
T))
(T NIL])
(Interp2
[LAMBDA (r ArgU) (* edited: "18-MAY-81 14:06")
(* assembles pieces of the heuristic rule
r, and runs them on argument ArgU)
(* This is a more "vocal" interpeter than
interp1)
(COND
((EVERY (SubSlots (QUOTE IfParts))
(QUOTE TrueIfItExists))
(AND (IsAlto)
(SnazzyHeuristic r))
(COND
((IGREATERP Verbosity 66)
(PRIN1 " All the IfParts of ")
(PRIN1 r)
(PRIN1 (Abbrev r))
(PRIN1 " are satisfied, so we are applying the ThenParts. ")
(TERPRI))
((IGREATERP Verbosity 29)
(PRIN1 r)
(PRIN1 " applies. ")
(TERPRI)))
(AND (MyTime (QUOTE (EVERY (SubSlots (QUOTE ThenParts))
(QUOTE XeqIfItExists)))
(QUOTE TimeThen))
(CPRIN1 68 CRLF " All the ThenParts of " r (Abbrev r)
" have been successfully executed. " CRLF)
[SETQ TimRec (OR (OverallRecord r)
(PUT r (QUOTE OverallRecord)
(CONS 0 0]
(RPLACD TimRec (ADD1 (CDR TimRec)))
(RPLACA TimRec (IPLUS (CAR TimRec)
TimeThen))
T))
(T NIL])
(Interp3
[LAMBDA (r ArgU ArgS) (* edited: "26-APR-81 18:33")
(* assembles pieces of the heuristic rule
r, and runs them on argument ArgU and slot
ArgS)
(* This is a more "vocal" interpeter than
interp1)
(RESETVARS (CurUnit CurSlot)
(SETQ CurUnit ArgU)
(SETQ CurSlot ArgS)
(COND
((EVERY (SubSlots (QUOTE IfParts))
(QUOTE TrueIfItExists))
(COND
((IGREATERP Verbosity 66)
(PRIN1 " All the IfParts of ")
(PRIN1 r)
(PRIN1 (Abbrev r))
(PRIN1 " are satisfied, so we are applying the ThenParts. ")
(TERPRI))
((IGREATERP Verbosity 29)
(PRIN1 r)
(PRIN1 " applies. ")
(TERPRI)))
(AND (MyTime (QUOTE (EVERY (SubSlots (QUOTE ThenParts))
(QUOTE XeqIfItExists)))
(QUOTE TimeThen))
(CPRIN1 68 CRLF " All the ThenParts of " r (Abbrev r)
" have been successfully executed. " CRLF)
[SETQ TimRec (OR (OverallRecord r)
(PUT r (QUOTE OverallRecord)
(CONS 0 0]
(RPLACD TimRec (ADD1 (CDR TimRec)))
(RPLACA TimRec (IPLUS (CAR TimRec)
TimeThen))
T))
(T NIL])
(Interrupts
[LAMBDA NIL (* edited: "31-Mar-81 21:13")
(* Control L for agenda length ;
Control N for numbe rof newly synthesized
units)
(INTERRUPTCHAR 12 (QUOTE (CPRIN1 -2 CRLF TAB TAB TAB TAB "Agenda length = " (LENGTH Agenda)
CRLF CRLF))
NIL)
(INTERRUPTCHAR 14 (QUOTE (CPRIN1 -2 CRLF TAB TAB TAB TAB (LENGTH NewU)
" newly synthesized units" CRLF CRLF))
NIL)
(INTERRUPTCHAR 22 [QUOTE (PROGN (CPRIN1 -2 CRLF CRLF TAB "Verbosity level was " Verbosity
"; new value: ")
([LAMBDA (R)
(AND (FIXP R)
(SETQ Verbosity R]
(RATOM TTY]
NIL])
(IsAKindOf
[LAMBDA (s S) (* edited: "23-FEB-81 13:45")
(OR (EQ s S)
(MEMB S (Generalizations s])
(IsAlto
[LAMBDA NIL (* edited: "15-MAY-81 20:26")
(EQ (QUOTE ALTO)
(SYSTEMTYPE])
(IsSubsetOf
[LAMBDA (L M) (* edited: " 9-APR-81 15:26")
(EVERY L (FUNCTION (LAMBDA (X)
(MEMBER X M])
(KillSlot
[LAMBDA (s U1 V1 temp) (* edited: "11-MAR-81 15:17")
(AND (Slotp s)
(OR U1 (AND (BOUNDP (QUOTE u))
(SETQ U1 u)))
(PROG1 (COND
([NULL (OR V1 (SETQ V1 (APPLY* s U1]
(LIST U1 (QUOTE had)
(QUOTE no)
s
(QUOTE slot)))
((SETQ temp (CAR (Inverse s)))
[MAPC V1 (FUNCTION (LAMBDA (e)
(REM1PROP e temp U1]
(QUOTE (via Inverse)))
((SETQ temp (ToDelete s))
(APPLY* temp V1 s U1)
(QUOTE (via ToDelete)))
((SETQ temp (ToDelete1 s))
[MAPC V1 (FUNCTION (LAMBDA (e)
(APPLY* temp e s U1]
(QUOTE (via ToDelete1)))
(T NIL))
(REMPROP U1 s])
(KillUnit
[LAMBDA (u) (* edited: "31-Mar-81 21:08")
(AND (Unitp u)
(NOT (MEMB u NewU))
(SETQ UndoKill (CONS (LIST u (COPY (GETPROPLIST u)))
UndoKill)))
(SETQ Units (DREMOVE u Units))
(SETQ NewU (DREMOVE u NewU))
(SETQ SynthU (DREMOVE u SynthU))
(SETQ Slots (DREMOVE u Slots))
(MAPC (APPEND (GETPROPLIST u))
(FUNCTION KillSlot)
(QUOTE CDDR))
[SETQ Agenda (SUBSET Agenda (FUNCTION (LAMBDA (ta)
(NEQ u (ExtractUnitName ta]
(QUOTE %.])
(KnownApplic
[LAMBDA (u a) (* edited: " 7-Mar-81 15:09")
(CAR (SOME (Applics u)
(FUNCTION (LAMBDA (AP)
(EQUAL a (CAR AP])
(LEQNN
[LAMBDA (x y) (* edited: "27-APR-81 16:25")
(AND (NUMBERP x)
(NUMBERP y)
(LEQ x y])
(LessWorth
[LAMBDA (U1 U2) (* edited: "10-MAR-81 16:57")
(COND
((NOT (Unitp U2))
NIL)
((NOT (Unitp U1))
T)
(T (ILESSP (Worth U1)
(Worth U2])
(ListifyIfNec
[LAMBDA (X) (* edited: "28-Feb-81 11:35")
(OR (LISTP X)
(CONS X NIL])
(ListsStarting
[LAMBDA (X L) (* edited: " 2-MAR-81 14:29")
(COND
((NLISTP L)
NIL)
[(EQ X (CAR L))
(CONS L (MAPCONC (CDR L)
(QUOTE ListsStartingAux]
(T (MAPCONC L (QUOTE ListsStartingAux])
(ListsStartingAux
[LAMBDA (L) (* edited: " 2-MAR-81 14:29")
(COND
((NLISTP L)
NIL)
[(EQ X (CAR L))
(CONS L (MAPCONC (CDR L)
(QUOTE ListsStartingAux]
(T (MAPCONC L (QUOTE ListsStartingAux])
(MAP2EVERY
[LAMBDA (L FL) (* edited: "27-APR-81 22:24")
(PROG NIL
LOOP(COND
((NULL L)
(RETURN T))
((NULL FL)
(RETURN T))
((NULL (APPLY* (CAR FL)
(CAR L)))
(RETURN NIL))
(T (SETQ FL (CDR FL))
(SETQ L (CDR L))
(GO LOOP])
(MAPAPPEND
[LAMBDA (L F) (* edited: " 3-MAR-81 17:11")
(COND
((NULL L)
NIL)
(T (NCONC (APPEND (APPLY* F (CAR L)))
(MAPAPPEND (CDR L)
F])
(MAXIMUM
[LAMBDA (L2 F2) (* edited: " 4-MAR-81 11:49")
(* The element of L2 having the highest
F-value)
(* Currently, this presumes that L2 is a
lis tof integers)
(COND
((NLISTP L2)
L2)
((NLISTP (CDR L2))
(CAR L2))
(T (PROG (M MV)
(SETQ M (CAR L2))
(SETQ MV (APPLY* F2 (CAR L2)))
LOOP(SETQ L2 (CDR L2))
(COND
((NULL L2)
(RETURN M)))
[COND
((IGREATERP (APPLY* F2 (CAR L2))
MV)
(SETQ M (CAR L2))
(SETQ MV (APPLY* F2 (CAR L2]
(GO LOOP])
(MAXIMUM2
[LAMBDA (L2 F2) (* edited: " 9-APR-81 13:58")
(* An element e of L2, such that F2
(x,e) is never true)
(* Currently, this presumes that L2 is a
lis tof integers)
(COND
((NLISTP L2)
L2)
((NLISTP (CDR L2))
(CAR L2))
(T (PROG (M)
(SETQ M (CAR L2))
LOOP(SETQ L2 (CDR L2))
(COND
((NULL L2)
(RETURN M)))
[COND
((APPLY* F2 (CAR L2)
M)
(SETQ M (CAR L2]
(GO LOOP])
(Map&Print
[LAMBDA (L F) (* edited: "11-MAR-81 12:02")
(MAPC L (FUNCTION (LAMBDA (Z)
(PRIN1 (APPLY* F Z])
(MapApplics
[LAMBDA (u F NIt WhenToCheck MaxRealTime MaxSpace gen genf gena)
(* edited: "24-Mar-81 17:58")
(* This may have to generate examples,
rather than merely calling Applics)
(MAPC (Applics u)
F)
(AND (SETQ gen (ApplicGenerator u))
(SETQ genf (ApplicGenBuild gen))
(SETQ gena (ApplicGenArgs gen))
(OR (FIXP NIt)
(SETQ NIt 300))
[OR (FIXP WhenToCheck)
(SETQ WhenToCheck (ADD1 (IQUOTIENT NIt 10]
[OR (FIXP MaxRealTime)
(SETQ MaxRealTime (TIMES CurPri UserImpatience
(ADD1 (FIX (PLUS .5 (LOG (MAX 2 (ADD1 Verbosity]
(OR MaxSpace (SETQ MaxSpace (Average CurPri 1000)))
(SELECTQ (LENGTH gena)
[1 (for j from 1 to NIt until (OR (TakingTooLong j WhenToCheck MaxRealTime)
(TakingTooMuchSpace j WhenToCheck MaxSpace u
(QUOTE Applics)))
do [PROGN (APPLY* F (EVAL (CAR gena)))
(SET (CAR gena)
(APPLY* (CAR genf)
(EVAL (CAR gena]
first (SET (CAR gena)
(CAR (ApplicGenInit gen]
(for j from 1 to NIt until (OR (TakingTooLong j WhenToCheck MaxRealTime)
(TakingTooMuchSpace j WhenToCheck MaxSpace u
(QUOTE Applics)))
do [PROGN (APPLYEVAL F gena)
(MAP2C gena genf (FUNCTION (LAMBDA (Var Fn)
(SET Var (APPLYEVAL Fn gena]
first (MAP2C gena (ApplicGenInit gen)
(QUOTE SET])
(MapExamples
[LAMBDA (u F NIt WhenToCheck MaxRealTime MaxSpace gen genf gena)
(* edited: "24-Mar-81 21:24")
(* This may have to generate examples,
rather than merely calling Applics)
(COND
[[AND (SETQ gen (Generator u))
(SETQ genf (GenBuild gen))
(SETQ gena (GenArgs gen))
(OR (FIXP NIt)
(SETQ NIt 1000))
[OR (FIXP WhenToCheck)
(SETQ WhenToCheck (ADD1 (IQUOTIENT NIt 10]
[OR (FIXP MaxRealTime)
(SETQ MaxRealTime (TIMES CurPri UserImpatience
(ADD1 (FIX (PLUS .5 (LOG (MAX 2 (ADD1 Verbosity]
(OR MaxSpace (SETQ MaxSpace (Average CurPri 500]
(SELECTQ (LENGTH gena)
[1 (for j from 1 to NIt until (OR (TakingTooLong j WhenToCheck MaxRealTime)
(TakingTooMuchSpace j WhenToCheck MaxSpace u
(QUOTE Examples)))
do [PROGN (APPLY* F (EVAL (CAR gena)))
(SET (CAR gena)
(APPLY* (CAR genf)
(EVAL (CAR gena]
first (SET (CAR gena)
(CAR (GenInit gen]
(for j from 1 to NIt until (OR (TakingTooLong j WhenToCheck MaxRealTime)
(TakingTooMuchSpace j WhenToCheck MaxSpace u
(QUOTE Examples)))
do [PROGN (APPLYEVAL F gena)
(MAP2C gena genf (FUNCTION (LAMBDA (Var Fn)
(SET Var (APPLYEVAL Fn gena]
first (MAP2C gena (GenInit gen)
(QUOTE SET]
(T (MAPC (Examples u)
F])
(MapUnion
[LAMBDA (L F sofar) (* edited: "26-MAR-81 13:31")
(* like MAPCONC, but instead of NCONCing
the results we simply, nondestructive,
union them)
[MAPC L (FUNCTION (LAMBDA (Q)
(SETQ sofar (UNION (APPLY* F Q)
sofar]
sofar])
(MergeProps
[LAMBDA (L M) (* edited: "11-MAR-81 15:12")
(* L and M are each property lists)
(MAP2C M (CDR M)
[FUNCTION (LAMBDA (P V)
(COND
((NOT (Slotp P))
NIL)
[(LISTGET L P)
(LISTPUT L (UNION (ListifyIfNec (LISTGET L P))
(ListifyIfNec V]
(T (SETQ L (NCONC L (LIST P V]
(QUOTE CDDR))
(* (NCONC (MAPCON L (FUNCTION (LAMBDA (LT) ((LAMBDA (GL) (COND
(GL (RPLACA GL (UNION (ListifyIfNec (CAR GL)) (ListifyIfNec
(CADR LT)))) NIL) (T (LIST (CAR LT) (CADR LT))))) (CDR (MEMB
(CAR LT) M))))) (QUOTE CDDR)) M))
L])
(MergeTasks
[LAMBDA (L M) (* edited: "15-MAY-81 20:28")
(PROG1 (MERGE [SUBSET L (FUNCTION (LAMBDA (TaskToBeAdded TaskAlreadyThere NewReas)
(COND
((NOT (WorthWorkingOn TaskToBeAdded))
NIL)
((SETQ TaskAlreadyThere (WholeTask (ExtractUnitName TaskToBeAdded)
(ExtractSlotName TaskToBeAdded)
(CurSup TaskToBeAdded)
Agenda))
(* Then it is already on the agenda!)
[NCONC (ExtractReasons TaskAlreadyThere)
(SETQ NewReas (SetDifference (ExtractReasons TaskToBeAdded)
(ExtractReasons
TaskAlreadyThere]
(CPRIN1 87 CRLF "Ha! this task was ALREADY on the agenda: "
(WaxOn TaskToBeAdded)
CRLF
"So instead of adding this as a NEW task, we just stick on the reasons "
NewReas ", and boost the priority to ")
(ResetPri TaskAlreadyThere (ExtractPriority TaskToBeAdded)
(ExtractPriority TaskAlreadyThere)
NewReas)
(CPRIN1 87 (ExtractPriority TaskAlreadyThere)
"." CRLF)
NIL)
(T T]
M
(QUOTE OrderTasks))
(SnazzyAgenda])
(MoreSpecific
[LAMBDA (u v) (* edited: " 9-APR-81 14:19")
(COND
((MEMB u (GETPROP v (QUOTE Generalizations)))
NIL)
((MEMB v (GETPROP u (QUOTE Generalizations)))
T)
([SOME (SubSlots (QUOTE Generalizations))
(FUNCTION (LAMBDA (s)
(MEMB u (GETPROP v s]
NIL)
([SOME (SubSlots (QUOTE Generalizations))
(FUNCTION (LAMBDA (s)
(MEMB v (GETPROP u s]
T)
((MEMB u (IsA v))
NIL)
((MEMB v (IsA u))
T)
(T (* I give up. Pretend that the bigger one
is more specific)
(IGREATERP (LENGTH (GETPROPLIST u))
(LENGTH (GETPROPLIST v])
(MostSpecific
[LAMBDA (L) (* edited: " 9-APR-81 14:25")
(MAXIMUM2 L (QUOTE MoreSpecific])
(MyTime
[LAMBDA (ex var val) (* edited: "30-MAR-81 15:50")
[SET (OR var (QUOTE TimedExpr))
(MINUS (IDIFFERENCE (CLOCK 2)
(PROGN (SETQ val (EVAL ex))
(CLOCK 2]
val])
(NU
[LAMBDA (N NOLD fullflg) (* edited: "22-APR-81 14:19")
(PROG1 [COND
((NOT (LITATOM N))
(PRIN1 "Must be atomic unit name! You typed: " TTY)
N)
((MEMB N Units)
(PRIN1 "Sorry, it is already a unit! " TTY)
N)
((MEMB NOLD Units)
(SETQ Units (CONS N Units))
[SETPROPLIST N (MergeProps (GETPROPLIST N)
(SUBST N NOLD (GETPROPLIST NOLD]
(SETQ WarnSlots NIL)
[MAPC (PROPNAMES N)
(FUNCTION (LAMBDA (P)
(COND
[(DontCopy P)
(COND
(fullflg (SETQ WarnSlots (CONS P WarnSlots)))
(T (REMPROP N P]
((DoubleCheck P)
(SETQ WarnSlots (CONS P WarnSlots]
(COND
(WarnSlots (CPRIN1 0 CRLF "Warning: doublecheck the values stored in: " WarnSlots
CRLF CRLF)))
(EVAL (LIST (QUOTE EU)
N))
(AddInv N)
(LIST N (QUOTE HasBeenInitialized)))
(T (SETQ Units (CONS N Units))
(PUT N (QUOTE Worth)
500)
(EVAL (LIST (QUOTE EU)
N))
(AddInv N)
(LIST N (QUOTE HasBeenInitialized]
(DefineIfSlot N])
(NUnitp
[LAMBDA (u) (* edited: "28-FEB-81 18:36")
(NOT (Unitp u])
(NearnessTo
[LAMBDA (N X) (* edited: "24-Feb-81 22:21")
(* This certainly works for nearness of N
to .1)
(DIFFERENCE 1000 (TIMES 100000 (SQUARE (DIFFERENCE N X])
(NewNam
[LAMBDA (A) (* edited: "25-FEB-81 18:52")
(PROG (N M)
(SETQ N 1)
NLOOP
(SETQ M (PACK* A (QUOTE -)
N))
(COND
((Unitp M)
(SETQ N (ADD1 N))
(GO NLOOP))
(T (RETURN M])
(NoRepeatsIn
[LAMBDA (L) (* edited: "23-Mar-81 10:46")
(COND
((NULL L)
T)
((NLISTP L)
NIL)
((MEMBER (CAR L)
(CDR L))
NIL)
(T (NoRepeatsIn (CDR L])
(OKBinPreds
[LAMBDA (u) (* edited: "27-APR-81 21:07")
(COND
((EQ u OldKBPu)
OldKBPv)
(T (SETQ OldKBPu u)
(SETQ OldKBPv (SUBSET (Examples (QUOTE BinaryPred))
(FUNCTION (LAMBDA (bp)
(AND [OR (HasHighWorth bp)
(MEMB bp (IntExamples (QUOTE BinaryPred]
(LEQNN (CAR (Rarity bp))
.3)
(EVERY (Domain bp)
(QUOTE Defn))
(RunDefn (CAR (Domain bp))
u])
(OrderTasks
[LAMBDA (T1 T2) (* edited: " 2-MAR-81 18:16")
(IGREATERP (CAR T1)
(CAR T2])
(PRINBOL
[LAMBDA (s v f SepLnFlg xp) (* edited: "18-MAY-81 18:22")
(* This prints s : (in bold) and then v
(indented))
(DSPBOLD (QUOTE ON)
f)
(PRIN1 s f)
(PRIN1 (QUOTE :% )
f)
(DSPBOLD (QUOTE OFF)
f)
(COND
[SepLnFlg (SETQ xp (DSPXPOSITION NIL f))
(MAPC v (FUNCTION (LAMBDA (ve)
(DSPXPOSITION xp f)
(PRINDEN ve f)
(PRINDEN CRLF f]
(T (PRINDEN v f)))
(PRIN1 CRLF f])
(PRINTASK
[LAMBDA (z fil) (* edited: "18-MAY-81 15:06")
(PRIN1 (ExtractPriority z)
fil)
(PRIN1 SPACE fil)
(PRIN1 (ExtractUnitName z)
fil)
(PRIN1 SPACE fil)
(PRIN1 (ExtractSlotName z)
fil)
[MAPC (CurSup z)
(FUNCTION (LAMBDA (s)
(SELECTQ (CAR s)
((SlotToUse SlotToChange)
(PRIN1 SPACE fil)
(PRIN1 (CAR s)
fil)
(PRIN1 (QUOTE =)
fil)
(PRIN1 (COND
((NULL (CDDR s))
(CADR s))
(T (CDR s)))
fil))
(PRIN1 (QUOTE ...)
fil]
(PRIN1 CRLF fil)
(PRIN1 TAB fil)
(PRIN1 (LENGTH (ExtractReasons z))
fil)
(PRIN1 SPACE fil)
(PRIN1 (QUOTE Reasons)
fil)
(PRIN1 CRLF fil])
(PU
[LAMBDA (u ns) (* edited: "18-MAY-81 15:25")
[COND
((NUMBERP u)
(SETQ u (CAR (NTH NewU u]
(TERPRI)
(PRIN1 u)
(PRIN1 (QUOTE :))
(TERPRI)
(TERPRI)
(MAP (GETPROPLIST u)
[FUNCTION (LAMBDA (PL)
(COND
((Slotp (CAR PL))
(PRIN1 (CAR PL))
(PRIN1 ": ")
(PRINTDEF (CADR PL))
(TERPRI))
(T (SETQ ns (CONS (CAR PL)
ns]
(QUOTE CDDR))
(AND ns (CPRIN1 -1 "
Plus " (LENGTH ns)
" properties which are not slot names: " ns CRLF))
(TERPRI)
u])
(PU2
[LAMBDA (u f ns sn) (* edited: "18-MAY-81 15:25")
[COND
((NUMBERP u)
(SETQ u (CAR (NTH NewU u]
(DSPBOLD (QUOTE ON)
f)
(PRIN1 u f)
(PRIN1 (QUOTE :)
f)
(PRIN1 CRLF f)
(PRIN1 CRLF f)
(DSPBOLD (QUOTE OFF)
f)
[MAPC (PROPNAMES u)
(FUNCTION (LAMBDA (s)
(COND
((Unitp s)
(SETQ sn (CONS s sn)))
(T (SETQ ns (CONS s ns]
[AND (BOUNDP (QUOTE CurSlot))
(PROGN (DSPBOLD (QUOTE ON)
f)
(PRIN1 CurSlot f)
(PRIN1 ": " f)
(DSPBOLD (QUOTE OFF)
f)
(PRIN1 (GETPROP u CurSlot)
f)
(PRIN1 CRLF f)
(SETQ sn (DREMOVE CurSlot sn]
[MAPC (APPEND sn)
(FUNCTION (LAMBDA (s)
(AND (EQ (QUOTE Text)
(DataType s))
(PROGN (DSPBOLD (QUOTE ON)
f)
(PRIN1 s f)
(PRIN1 ": " f)
(DSPBOLD (QUOTE OFF)
f)
(PRINDEN (GETPROP u s)
f)
(PRIN1 CRLF f)
(SETQ sn (DREMOVE s sn]
[MAPC (APPEND sn)
(FUNCTION (LAMBDA (s)
(AND (ATOM (GETPROP u s))
(PROGN (DSPBOLD (QUOTE ON)
f)
(PRIN1 s f)
(PRIN1 ": " f)
(DSPBOLD (QUOTE OFF)
f)
(PRINDEN (GETPROP u s)
f)
(PRIN1 CRLF f)
(SETQ sn (DREMOVE s sn]
[MAPC (APPEND sn)
(FUNCTION (LAMBDA (s)
(AND (EVERY (GETPROP u s)
(QUOTE ATOM))
[OR [NOT (ATOM (CDR (GETPROP u s]
(NULL (CDR (GETPROP u s]
(PROGN (DSPBOLD (QUOTE ON)
f)
(PRIN1 s f)
(PRIN1 ": " f)
(DSPBOLD (QUOTE OFF)
f)
(SELECTQ (LENGTH (GETPROP u s))
((0 1 2 3 4 5 6 7 8)
(PRINDEN (GETPROP u s)
f))
(PROGN (PRIN1 (QUOTE %()
f)
[MAP2C (QUOTE (1 2 3 4 5))
(GETPROP u s)
(FUNCTION (LAMBDA (k x)
(PRINDEN x f)
(PRINDEN SPACE f]
(PRINDEN (QUOTE +)
f)
(PRINDEN (DIFFERENCE (LENGTH (GETPROP u s))
5)
f)
(PRINDEN (QUOTE % more%))
f)))
(PRIN1 CRLF f)
(SETQ sn (DREMOVE s sn]
[MAPC (APPEND sn)
(FUNCTION (LAMBDA (s)
(AND (EVERY (GETPROP u s)
(QUOTE ATOM))
(PROGN (DSPBOLD (QUOTE ON)
f)
(PRIN1 s f)
(PRIN1 ": " f)
(DSPBOLD (QUOTE OFF)
f)
(SELECTQ (LENGTH (GETPROP u s))
((0 1 2 3 4 5 6 7 8)
(PRINDEN (GETPROP u s)
f))
(PROGN (PRIN1 (QUOTE %()
f)
[MAP2C (QUOTE (1 2 3 4 5))
(GETPROP u s)
(FUNCTION (LAMBDA (k x)
(PRINDEN x f)
(PRINDEN SPACE f]
(PRINDEN (QUOTE +)
f)
(PRINDEN (DIFFERENCE (LENGTH (GETPROP u s))
5)
f)
(PRINDEN (QUOTE % more%))
f)))
(PRIN1 CRLF f)
(SETQ sn (DREMOVE s sn]
(AND sn (PROGN (PRIN1 "
Plus " f)
(PRIN1 (LENGTH sn)
f)
(PRIN1 " big slots: " f)
(PRIN1 sn f)
(PRIN1 CRLF f)))
(AND ns (PROGN (PRIN1 "
Plus " f)
(PRIN1 (LENGTH ns)
f)
(PRIN1 " properties which are not slot names: " f)
(PRIN1 ns f)
(PRIN1 CRLF f)))
(PRIN1 CRLF f)
u])
(Percentify
[LAMBDA (N) (* edited: " 2-MAR-81 17:59")
(CONCAT (FIX (TIMES 100 (PLUS N .005)))
(QUOTE "%%"])
(PunishSeverely
[LAMBDA (u) (* edited: "18-MAR-81 16:32")
(AND (Unitp u)
(PUT u (QUOTE Worth)
(Half (Worth u])
(Quoted
[LAMBDA (X) (* edited: " 2-MAR-81 11:34")
(AND (LISTP X)
(EQ (CAR X)
(QUOTE QUOTE])
(REM1PROP
[LAMBDA (a p v) (* edited: "18-MAR-81 11:13")
(OR (NOT (LITATOM a))
(NOT (LITATOM p))
(AND (MEMB v (GETPROP a p))
(DREMOVE v (GETPROP a p)))
(DREMOVE v (APPLY* p a))
(REMPROP a p])
(RandomChoose
[LAMBDA (L) (* edited: "25-MAR-81 12:15")
[AND (LITATOM L)
(MEMB (QUOTE Set)
(IsA L))
(SETQ L (OR (Examples L)
(GatherExamples L]
(CAR (NTH L (RAND 1 (LENGTH L])
(RandomP
[LAMBDA NIL (* edited: "23-FEB-81 14:25")
(EQ 1 (RAND 0 1])
(RandomPair
[LAMBDA (L Rel) (* edited: "24-Apr-81 02:06")
(RandomChoose (AllPairs L Rel])
(RandomSubset
[LAMBDA (L) (* edited: "25-MAR-81 12:18")
[AND (LITATOM L)
(MEMB (QUOTE Set)
(IsA L))
(SETQ L (OR (Examples L)
(GatherExamples L]
(SUBSET L (QUOTE RandomP])
(RandomSubst
[LAMBDA (X Y Z NTries tes) (* edited: "20-Mar-81 00:38")
(OR NTries (SETQ NTries 4))
(COND
((ZEROP NTries)
Z)
((EQUAL (SETQ tes (RandomSubst* X Y Z))
Z)
(RandomSubst X Y Z (SUB1 NTries)))
(T tes])
(RandomSubst*
[LAMBDA (X Y Z) (* edited: "20-Mar-81 00:26")
(COND
((EQUAL X Y)
Z)
((EQUAL Y Z)
(COND
((RandomP)
Y)
(T X)))
((NLISTP Z)
Z)
(T (CONS (RandomSubst* X Y (CAR Z))
(RandomSubst* X Y (CDR Z])
(RepeatsIn
[LAMBDA (L) (* edited: "22-APR-81 14:30")
(COND
((NULL L)
NIL)
((NLISTP L)
NIL)
((MEMBER (CAR L)
(CDR L))
T)
(T (RepeatsIn (CDR L])
(ReportOn
[LAMBDA (L N) (* edited: "28-Mar-81 11:40")
(COND
((LITATOM L)
(SETQ L (LIST L)))
((NLISTP L)
(SETQ L NIL)))
(MAPC L (FUNCTION (LAMBDA (u)
(CPRIN1 N " there are " (LENGTH (GatherExamples u))
" " u (QUOTE s)
" "
(COND
((EQ u (QUOTE ReprConcept))
(LIST (LENGTH Slots)
(QUOTE of)
(QUOTE which)
(QUOTE are)
(QUOTE kinds)
(QUOTE of)
(QUOTE slots)))
(T " "))
CRLF])
(ResetPri
[LAMBDA (OldT NewP OldP NewR) (* edited: "23-Mar-81 15:49")
(* Given an old task OldT with priority OldP we have added it anew to the agenda
with priority NewP and brand new reasons NewR)
(RPLACA OldT (MIN 1000 (IPLUS (MAX OldP NewP)
(MAX 10 (ITIMES 100 (LENGTH NewR])
(RuleTakingTooLong
[LAMBDA NIL (* edited: "27-APR-81 15:09")
(OR (AND (IGEQ (CLOCK 0)
MaxRuleTime)
(CPRIN1 51 " Hmmm... this rule is taking too long! On to better rules!" CRLF)
T)
(AND (IGEQ (COUNT (GETPROP CurUnit CurSlot))
MaxRuleSpace)
(CPRIN1 51
" Grumble... this rule is taking too much space! On to less expansive rules!"
CRLF)
T])
(RunAlg
[LAMBDA (f a b c d e val) (* edited: "27-APR-81 23:01")
[COND
[(AND (SETQ val (COND
((Alg f)
(APPLY* (Alg f)
a b c d e))
((GETD f)
(EVAL (LIST f a b c d e)))
(T NIL)))
(NEQ val (QUOTE Failed)))
(OR (Rarity f)
(PUT f (QUOTE Rarity)
(LIST 0 0 0)))
[RPLACA (CDR (Rarity f))
(ADD1 (CADR (Rarity f]
(RPLACA (Rarity f)
(QUOTIENT (FLOAT (CADR (Rarity f)))
(IPLUS (CADR (Rarity f))
(CADDR (Rarity f]
(T (OR (Rarity f)
(PUT f (QUOTE Rarity)
(LIST 0 0 0)))
[RPLACA (CDDR (Rarity f))
(ADD1 (CADDR (Rarity f]
(RPLACA (Rarity f)
(QUOTIENT (FLOAT (CADR (Rarity f)))
(IPLUS (CADR (Rarity f))
(CADDR (Rarity f]
val])
(RunDefn
[LAMBDA (f a b c d e val) (* edited: "27-APR-81 23:01")
[COND
[(AND (SETQ val (COND
((Defn f)
(APPLY* (Defn f)
a b c d e))
((GETD f)
(EVAL (LIST f a b c d e)))
(T NIL)))
(NEQ val (QUOTE Failed)))
(OR (Rarity f)
(PUT f (QUOTE Rarity)
(LIST 0 0 0)))
[RPLACA (CDR (Rarity f))
(ADD1 (CADR (Rarity f]
(RPLACA (Rarity f)
(QUOTIENT (FLOAT (CADR (Rarity f)))
(IPLUS (CADR (Rarity f))
(CADDR (Rarity f]
(T (OR (Rarity f)
(PUT f (QUOTE Rarity)
(LIST 0 0 0)))
[RPLACA (CDDR (Rarity f))
(ADD1 (CADDR (Rarity f]
(RPLACA (Rarity f)
(QUOTIENT (FLOAT (CADR (Rarity f)))
(IPLUS (CADR (Rarity f))
(CADDR (Rarity f]
val])
(SOME1
[LAMBDA (L F) (* edited: " 1-May-81 01:14")
(COND
((NULL L)
NIL)
((APPLY* F (CAR L)))
(T (SOME1 (CDR L)
F])
(SOS
[LAMBDA NIL (* edited: "18-MAR-81 11:46")
(COND
((DRIBBLEFILE)
(CPRIN1 -1 "Closing " (DRIBBLEFILE)
CRLF))
(T (PRIN1 "Note: no dribble file was previously open.")
(TERPRI)))
(DRIBBLE (PACK* (QUOTE TRACE.)
(Date2)))
(CPRIN1 -1 (DRIBBLEFILE)
" is now open." CRLF)
(DATE])
(SQUARE
[LAMBDA (X) (* edited: "24-Feb-81 22:19")
(TIMES X X])
(START
[LAMBDA (EternalFlg) (* edited: "18-MAY-81 14:58")
(CycleThruAgenda)
(PROG (UnitsFocusedOn UU)
LOOP(COND
((SETQ UU (SetDiff Units UnitsFocusedOn)))
(EternalFlg (CPRIN1 3 CRLF CRLF CRLF
"Have focused on all the units at least once. Starting another pass through them."
CRLF CRLF CRLF)
(SETQ UnitsFocusedOn NIL))
(T (PRIN1 "
Should I continue with another pass? ")
(OR (YesNo)
(RETURN (QUOTE EuriskoHalting)))
(SETQ UnitsFocusedOn NIL)))
(SETQ UnitsFocusedOn (CONS (WorkOnUnit (MAXIMUM UU (QUOTE Worth)))
UnitsFocusedOn))
(AND (IsAlto)
(NULL Agenda)
(DSPRESET BitAgenda)
(PRIN1 (CONS (LENGTH UU)
(QUOTE (concepts still must be focused on sometime)))
BitAgenda))
(GO LOOP])
(SelfIntersect
[LAMBDA (X) (* edited: "19-FEB-81 16:36")
(INTERSECTION X X])
(SetDiff
[LAMBDA (L M) (* edited: "23-FEB-81 19:03")
(* presumes that L and M are lists of
atoms. Nondestructive)
(SUBSET L (FUNCTION (LAMBDA (v)
(NOT (MEMB v M])
(SetDifference
[LAMBDA (L M) (* edited: "27-Mar-81 21:43")
(* presumes that L and M are lists of
atoms. Nondestructive)
(SUBSET L (FUNCTION (LAMBDA (v)
(NOT (MEMBER v M])
(SetIntersect
[LAMBDA (L M) (* edited: "11-MAR-81 11:44")
(SUBSET L (FUNCTION (LAMBDA (Z)
(MEMB Z M])
(SetUnion
[LAMBDA (s1 s2) (* edited: "22-APR-81 15:36")
(APPEND (SetDifference s1 s2)
s2])
(Shorten
[LAMBDA (A) (* edited: " 1-May-81 00:32")
(CAR (UNPACK A])
(SibSlots
[LAMBDA (s) (* edited: "11-MAR-81 13:26")
(MapUnion (SuperSlots s)
(QUOTE SubSlots])
(Sibs
[LAMBDA (u) (* edited: " 9-APR-81 13:47")
(Examples (MostSpecific (APPEND (IsA u])
(SlotNames
[LAMBDA (u) (* edited: "23-FEB-81 14:16")
(SUBSET (PROPNAMES u)
(FUNCTION (LAMBDA (S)
(NOT (MEMB S SYSPROPS])
(SlotSubst
[LAMBDA (N NOLD L) (* edited: "18-MAR-81 15:44")
(COND
((NULL L)
NIL)
(T (CONS (CAR L)
(CONS (SUBST N NOLD (CADR L))
(SlotSubst N NOLD (CDDR L])
(Slotp
[LAMBDA (s) (* edited: "23-Mar-81 16:46")
(DoesIntersect (QUOTE (Slot CriterialSlot NonCriterialSlot))
(GETPROP s (QUOTE IsA])
(SmartPACK*
[LAMBDA U (* edited: " 1-May-81 01:23")
(OR (AND (IGEQ (for ti from 1 to U sum (NCHARS (ARG U ti)))
100)
[SETQ ShorterNam (APPLY (QUOTE SmartPack*)
(for ti from 1 to U collect (Shorten (ARG U ti]
(SELECTQ (IQUOTIENT Verbosity 20)
(0 T)
(1 (PRIN1 0 TAB "Oh, those long names! I just had to shorten one." CRLF))
((2 3 4)
(CPRIN1 0 CRLF "Oh, those long names!!! I will have to shorten " " one to "
ShorterNam CRLF))
(CPRIN1 20 CRLF "Oh, those long names!!! I will have to shorten "
(PROGN (for ti from 1 to U do (PRIN1 (ARG U ti)
TTY))
" to ")
ShorterNam CRLF)))
(APPLY (QUOTE OldPACK*)
(for ti from 1 to U collect (ARG U ti])
(Snazzy
[LAMBDA NIL (* edited: "18-MAY-81 17:27")
(DISPLAYSTREAMINIT 40)
(CLR)
(DSPFILL (QUOTE (0 300 610 25))
GRAYSHADE)
(DSPFILL (QUOTE (202 125 199 22))
GRAYSHADE)
(DRAWLINE 0 322 610 322 6)
(DRAWLINE 200 300 200 325 6)
(DRAWLINE 400 300 400 325 6)
(DRAWLINE 401 300 401 0 4)
(DRAWLINE 201 300 201 0 4)
(DRAWLINE 0 300 610 300 6)
(DRAWLINE 201 147 400 147 6)
(DRAWLINE 201 125 400 125 6)
(SETQ BitTitleAgenda (DSPCREATE))
(DSPXPOSITION 460 BitTitleAgenda)
(DSPYPOSITION 310 BitTitleAgenda)
(DSPBOLD (QUOTE ON)
BitTitleAgenda)
(PRIN1 (QUOTE % Current-Agenda% )
BitTitleAgenda)
(SETQ BitTitleTask (DSPCREATE))
(DSPXPOSITION 260 BitTitleTask)
(DSPYPOSITION 310 BitTitleTask)
(DSPBOLD (QUOTE ON)
BitTitleTask)
(PRIN1 (QUOTE % Current-Task% )
BitTitleTask)
(SETQ BitTitleCurHeur (DSPCREATE))
(DSPXPOSITION 240 BitTitleCurHeur)
(DSPYPOSITION 135 BitTitleCurHeur)
(DSPBOLD (QUOTE ON)
BitTitleCurHeur)
(PRIN1 (QUOTE % Current-Heuristic% )
BitTitleCurHeur)
(SETQ BitTitleCurUnit (DSPCREATE))
(DSPXPOSITION 45 BitTitleCurUnit)
(DSPYPOSITION 310 BitTitleCurUnit)
(DSPBOLD (QUOTE ON)
BitTitleCurUnit)
(PRIN1 (QUOTE % Current-Concept% )
BitTitleCurUnit)
(SETQ BitConcept (DSPCREATE))
(SETQ BitConceptRegion (create REGION
LEFT ← 2
BOTTOM ← 0
WIDTH ← 188
HEIGHT ← 295))
(DSPXPOSITION 2 BitConcept)
(DSPYPOSITION 280 BitConcept)
(DSPLEFTMARGIN 2 BitConcept)
(DSPRIGHTMARGIN 235 BitConcept)
(DSPCLIPPINGREGION BitConceptRegion BitConcept)
(OR (BOUNDP (QUOTE Helv8))
(SETQ Helv8 (FONTCREATE (QUOTE HELVETICA)
8)))
[OR (BOUNDP (QUOTE Helv8B))
(SETQ Helv8B (FONTCREATE (QUOTE HELVETICA)
8
(QUOTE BOLD]
(DSPFONT Helv8 BitConcept)
(SnazzyConcept T)
(SETQ BitTaskRegion (create REGION
LEFT ← 206
BOTTOM ← 154
WIDTH ← 190
HEIGHT ← 141))
(SETQ BitHeuristicRegion (create REGION
LEFT ← 206
BOTTOM ← 0
WIDTH ← 188
HEIGHT ← 120))
(SETQ BitHeuristic (DSPCREATE))
(DSPXPOSITION 207 BitHeuristic)
(DSPYPOSITION 105 BitHeuristic)
(DSPCLIPPINGREGION BitHeuristicRegion BitHeuristic)
(DSPLEFTMARGIN 207 BitHeuristic)
(DSPRIGHTMARGIN 425 BitHeuristic)
(OR (BOUNDP (QUOTE Helv9))
(SETQ Helv9 (FONTCREATE (QUOTE HELVETICA)
9)))
[OR (BOUNDP (QUOTE Helv9B))
(SETQ Helv9B (FONTCREATE (QUOTE HELVETICA)
9
(QUOTE BOLD]
(DSPFONT Helv9 BitHeuristic)
(SnazzyHeuristic)
(SETQ BitTask (DSPCREATE))
(DSPXPOSITION 207 BitTask)
(DSPYPOSITION 280 BitTask)
(DSPCLIPPINGREGION BitTaskRegion BitTask)
(DSPLEFTMARGIN 207 BitTask)
(DSPRIGHTMARGIN 398 BitTask)
(OR (BOUNDP (QUOTE Helv9))
(SETQ Helv9 (FONTCREATE (QUOTE HELVETICA)
9)))
[OR (BOUNDP (QUOTE Helv9B))
(SETQ Helv9B (FONTCREATE (QUOTE HELVETICA)
9
(QUOTE BOLD]
(DSPFONT Helv8 BitTask)
(SnazzyTask)
(SETQ BitAgenda (DSPCREATE))
(SETQ BitAgendaRegion (create REGION
LEFT ← 406
BOTTOM ← 0
WIDTH ← 190
HEIGHT ← 295))
(DSPXPOSITION 406 BitAgenda)
(DSPYPOSITION 280 BitAgenda)
(DSPLEFTMARGIN 406 BitAgenda)
(DSPRIGHTMARGIN 610 BitAgenda)
(DSPCLIPPINGREGION BitAgendaRegion BitAgenda)
(OR (BOUNDP (QUOTE Helv8))
(SETQ Helv8 (FONTCREATE (QUOTE HELVETICA)
8)))
(DSPFONT Helv8 BitAgenda)
(SETQ BAList (for nts from 1 to 10 collect BitAgenda))
(SnazzyAgenda])
(SnazzyAgenda
[LAMBDA NIL (* edited: "18-MAY-81 12:38")
(DSPRESET BitAgenda)
(COND
((AND (BOUNDP (QUOTE Agenda))
Agenda)
(PRIN1 TAB BitAgenda)
(PRIN1 (LENGTH Agenda)
BitAgenda)
(PRIN1 (QUOTE % TASKS)
BitAgenda)
(PRIN1 CRLF BitAgenda)
(PRIN1 CRLF BitAgenda)
(MAP2C Agenda BAList (QUOTE PRINTASK)))
((BOUNDP (QUOTE Agenda))
(PRIN1 "THE AGENDA IS NOW EMPTY" BitAgenda))
(T (PRIN1 "THE AGENDA HAS NOT YET BEEN INITIALIZED, EVEN!" BitAgenda])
(SnazzyConcept
[LAMBDA (forceflg u) (* edited: "18-MAY-81 15:03")
(AND (NULL u)
(BOUNDP (QUOTE CurUnit))
(SETQ u CurUnit))
(COND
((AND (NULL forceflg)
(BOUNDP (QUOTE LastUSnazzed))
(EQ u LastUSnazzed)))
(T (DSPRESET BitConcept)
(COND
(u (SETQ LastUSnazzed u)
(PU2 u BitConcept))
(T (PRIN1 "NO CURRENT CONCEPT YET" BitConcept])
(SnazzyHeuristic
[LAMBDA (r) (* edited: "18-MAY-81 18:13")
(DSPRESET BitHeuristic)
(COND
(r (DSPBOLD (QUOTE ON)
BitHeuristic)
(PRIN1 r BitHeuristic)
(PRIN1 (QUOTE :% )
BitHeuristic)
(DSPBOLD (QUOTE OFF)
BitHeuristic)
(PRIN1 (English r)
BitHeuristic)
(PRIN1 CRLF BitHeuristic))
(T (PRIN1 "NO CURRENT HEURISTIC NOW" BitHeuristic])
(SnazzyTask
[LAMBDA (tsk) (* edited: "18-MAY-81 18:13")
(DSPRESET BitTask)
(AND (NULL tsk)
(BOUNDP (QUOTE task))
(SETQ tsk task))
(COND
(tsk (DSPBOLD (QUOTE ON)
BitTask)
(PRIN1 (QUOTE Task% )
BitTask)
(PRIN1 TaskNum BitTask)
(PRIN1 (QUOTE :% )
BitTask)
(PRIN1 CRLF BitTask)
(PRIN1 CRLF BitTask)
(DSPBOLD (QUOTE OFF)
BitTask)
(PRINBOL (QUOTE Priority)
(ExtractPriority tsk)
BitTask)
(PRINBOL (QUOTE UnitToWorkOn)
(ExtractUnitName tsk)
BitTask)
(PRINBOL (QUOTE SlotToWorkOn)
(ExtractSlotName tsk)
BitTask)
[MAPC (CurSup tsk)
(FUNCTION (LAMBDA (sp)
(PRINBOL (CAR sp)
(COND
((NULL (CDDR sp))
(CADR sp))
(T (CDR sp)))
BitTask]
(SELECTQ (LENGTH (ExtractReasons tsk))
(0 NIL)
(1 (PRINBOL (QUOTE Reason)
(CAR (ExtractReasons tsk))
BitTask))
(PRINBOL (CONCAT (LENGTH (ExtractReasons tsk))
" Reasons")
(ExtractReasons tsk)
BitTask T)))
(T (PRIN1 "NO CURRENT TASK NOW" BitTask])
(SomeOPair
[LAMBDA (L Rel v) (* edited: "24-Apr-81 01:48")
(COND
((ILESSP (LENGTH L)
2)
NIL)
([SOME (CDR L)
(FUNCTION (LAMBDA (L2)
(AND (SETQ v (APPLY* Rel (CAR L)
L2))
(SETQ v (LIST L2 v]
(CONS (L L1)
v))
(T (SomePair (CDR L)
Rel])
(SomePair
[LAMBDA (L Rel) (* edited: "24-Apr-81 01:48")
(OR (SomeOPair L Rel)
(SomeOPair (REVERSE L)
Rel])
(SomeUneliminated
[LAMBDA NIL (* edited: "27-Mar-81 21:19")
(SOME Units (FUNCTION (LAMBDA (u)
(OR [SOME SlotsToElimInitially (FUNCTION (LAMBDA (s)
(GETPROP u s]
(SOME (ElimSlots u)
(FUNCTION (LAMBDA (s)
(GETPROP u s])
(SortByWorths
[LAMBDA (L) (* edited: "10-MAR-81 16:55")
(SORT L (QUOTE LessWorth])
(Specializations
[LAMBDA (u) (* edited: "19-FEB-81 16:36")
(SelfIntersect (NCONC [MAPCONC (GETPROP (QUOTE Specializations)
(QUOTE SubSlots))
(FUNCTION (LAMBDA (ss)
(APPEND (GETPROP u ss]
(GETPROP u (QUOTE Specializations])
(Specialize1LispExpr
[LAMBDA (bod tmp tmp2 fbod) (* edited: "20-Mar-81 00:15")
(* AreUnits is the list of units mentioned
in bod ; HaveSpec are those which have
specializations already)
(COND
([SETQ tmp2 (RandomChoose (Specializations
(SETQ tmp (RandomChoose
(SETQ HaveSpec (UNION (SUBSET (SETQ AreUnits
(SUBSET (SETQ fbod
(SelfIntersect
(Flatten bod)))
(QUOTE Unitp)))
(QUOTE Specializations))
HaveSpec]
(SETQ UDiff (LIST tmp RArrow tmp2))
(RandomSubst tmp2 tmp bod))
([SETQ tmp2 (SpecializeNumber (SETQ tmp (RandomChoose (SUBSET (SelfIntersect fbod)
(QUOTE NUMBERP]
(SETQ UDiff (LIST tmp RArrow tmp2))
(RandomSubst tmp2 tmp bod))
(T bod])
(Specialize1LispFn
[LAMBDA (bod) (* edited: "18-MAR-81 12:01")
(Specialize1LispExpr bod])
(Specialize1LispPred
[LAMBDA (bod tmp tmp2) (* edited: "18-MAR-81 12:02")
(Specialize1LispExpr bod])
(SpecializeBit
[LAMBDA (b) (* edited: "28-Feb-81 17:22")
(NOT b])
(SpecializeCompiledLispCode
[LAMBDA (X) (* edited: " 4-MAR-81 16:08")
X])
(SpecializeDataType
[LAMBDA (x tmp) (* edited: " 6-MAR-81 16:03")
(COND
[(LISTP x)
(MAPCAR x (FUNCTION (LAMBDA (Z)
(COND
((RandomP)
(SpecializeDataType Z))
(T Z]
((SETQ tmp (RandomChoose (Specializations x)))
(SETQ UDiff (LIST x RArrow tmp))
tmp)
(T x])
(SpecializeDottedPair
[LAMBDA (x) (* edited: " 1-APR-81 14:36")
x])
(SpecializeIOPair
[LAMBDA (x) (* edited: " 2-MAR-81 18:20")
(* eventually: look thru the (i o) pairs, and make a few new ones, with i's
selected from the set of i's, and o's similarly -- or select from examples of
things which i and o are examples of)
x])
(SpecializeLispFn
[LAMBDA (x) (* edited: " 3-Apr-81 00:33")
(* presumed to be given either the name of
a predicate, or a list of the form
(LAMBDA --))
(COND
((NUMBERP x)
(SpecializeNumber x))
((LITATOM x)
(COND
[(Specializations x)
(CADDR (SETQ UDiff (LIST x RArrow (RandomChoose (Specializations x]
(T x)))
((NLISTP x)
x)
[(LISTP (CAR x))
(MAPCAR x (FUNCTION (LAMBDA (Z)
(COND
((RandomP)
(SpecializeLispFn Z))
(T Z]
[(EQ (CAR x)
(QUOTE LAMBDA))
(CONS (QUOTE LAMBDA)
(CONS (CADR x)
(MAPCAR (CDDR x)
(QUOTE Specialize1LispFn]
(T x])
(SpecializeLispPred
[LAMBDA (x) (* edited: " 3-Apr-81 00:33")
(* presumed to be given either the name of
a predicate, or a list of the form
(LAMBDA --))
(COND
((NUMBERP x)
(SpecializeNumber x))
((LITATOM x)
(COND
[(Specializations x)
(CADDR (SETQ UDiff (LIST x RArrow (RandomChoose (Specializations x]
(T x)))
((NLISTP x)
x)
[(LISTP (CAR x))
(MAPCAR x (FUNCTION (LAMBDA (Z)
(COND
((RandomP)
(SpecializeLispPred Z))
(T Z]
[(EQ (CAR x)
(QUOTE LAMBDA))
(CONS (QUOTE LAMBDA)
(CONS (CADR x)
(MAPCAR (CDDR x)
(QUOTE Specialize1LispPred]
(T x])
(SpecializeList
[LAMBDA (x) (* edited: "25-FEB-81 17:12")
(COND
[(LISTP (CAR x))
(MAPCAR x (FUNCTION (LAMBDA (Z)
(COND
((RandomP)
(SpecializeList Z))
(T Z]
(T (SETQ UDiff (LIST (QUOTE Eliminated:)))
(SUBSET x (FUNCTION (LAMBDA (R)
(COND
((RandomP)
(NCONC1 UDiff R)
NIL)
(T T])
(SpecializeNIL
[LAMBDA (X) (* edited: "23-FEB-81 14:51")
(WARNING (CONS X " can't be specialized if it doesn't have a known DataType! "])
(SpecializeNumber
[LAMBDA (x) (* edited: "26-Feb-81 15:29")
(COND
[(LISTP x)
(MAPCAR x (FUNCTION (LAMBDA (Z)
(COND
((RandomP)
(SpecializeNumber Z))
(T Z]
[(FIXP x)
(CADDR (SETQ UDiff (LIST x RArrow (RAND 1 x]
[(NUMBERP x)
(CADDR (SETQ UDiff (LIST x RArrow (QUOTIENT (RAND 0 (FIX (TIMES x 200)))
200.0]
(T NIL])
(SpecializeSlot
[LAMBDA (x tmp) (* edited: "25-FEB-81 17:27")
(COND
[(LISTP x)
(MAPCAR x (FUNCTION (LAMBDA (Z)
(COND
((RandomP)
(SpecializeSlot Z))
(T Z]
((SETQ tmp (RandomChoose (Specializations x)))
(SETQ UDiff (LIST x RArrow tmp))
tmp)
(T x])
(SpecializeText
[LAMBDA (x) (* edited: "25-FEB-81 17:26")
(COND
[(LISTP (CAR x))
(MAPCAR x (FUNCTION (LAMBDA (Z)
(COND
((RandomP)
(SpecializeText Z))
(T Z]
(T (SETQ UDiff (LIST (QUOTE Eliminated:)))
(SUBSET x (FUNCTION (LAMBDA (R)
(COND
((RandomP)
(NCONC1 UDiff R)
NIL)
(T T])
(SpecializeUnit
[LAMBDA (x tmp) (* edited: "25-FEB-81 17:27")
(COND
[(LISTP x)
(MAPCAR x (FUNCTION (LAMBDA (Z)
(COND
((RandomP)
(SpecializeUnit Z))
(T Z]
((SETQ tmp (RandomChoose (Specializations x)))
(SETQ UDiff (LIST x RArrow tmp))
tmp)
(T x])
(StrongUnsaveDef
[LAMBDA (F) (* edited: " 2-MAR-81 15:46")
(COND
((EQ (QUOTE nothing)
(CAR (UNSAVEDEF F)))
(CAR (LOADDEF F)))
(T F])
(TakingTooLong
[LAMBDA (j WhenToCheck MaxRealTime) (* edited: "24-Mar-81 17:51")
(COND
((LEQ j 1)
(SETQ MapCycleTime (CLOCK 0))
NIL)
((AND (EQ 0 (REMAINDER j WhenToCheck))
(IGEQ (DIFFERENCE (CLOCK 0)
MapCycleTime)
MaxRealTime))
(CPRIN1 56 " Hmmm... this is taking too long! On to better things!" CRLF)
T)
(T NIL])
(TakingTooMuchSpace
[LAMBDA (j WhenToCheck MaxSpace u s) (* edited: "24-Mar-81 17:51")
(COND
((LEQ j 1)
NIL)
((AND (EQ 0 (REMAINDER j WhenToCheck))
(IGEQ (COUNT (GETPROP u s))
MaxSpace))
(CPRIN1 56 " Grumble... this is taking too much space! On to less expansive things!" CRLF)
T)
(T NIL])
(TheFirstOf
[LAMBDA (X Y) (* edited: "18-MAR-81 15:52")
X])
(TheNumberOf
[LAMBDA (L F N) (* edited: "23-Mar-81 16:02")
(SETQ N 0)
[MAPC L (FUNCTION (LAMBDA (X)
(COND
((APPLY* F X)
(SETQ N (ADD1 N)))
(T NIL]
N])
(TheSecondOf
[LAMBDA (X Y) (* edited: "18-MAR-81 16:58")
Y])
(TinyReward
[LAMBDA (u) (* edited: "18-MAR-81 12:07")
(PUT u (QUOTE Worth)
(ADD1 (Worth u])
(TrueIfItExists
[LAMBDA (s) (* edited: "15-FEB-81 15:40")
(* This is an aux fn of rule interpreters. We assume that the interpreter is being
run on a rule called r, which is to be applied to a unit ArgU)
([LAMBDA (z)
(COND
((NULL z))
((ILESSP Verbosity 80)
(APPLY* z ArgU))
((APPLY* z ArgU)
(PRIN1 " the ")
(PRIN1 s)
(PRIN1 " slot of ")
(PRIN1 r)
(PRIN1 " holds for ")
(PRIN1 ArgU)
(TERPRI)
T)
((IGREATERP Verbosity 95)
(PRIN1 " the ")
(PRIN1 s)
(PRIN1 " slot of ")
(PRIN1 r)
(PRIN1 " didn't hold for ")
(PRIN1 ArgU)
(TERPRI)
NIL]
(APPLY* s r])
(UnGet
[LAMBDA (flag) (* edited: " 3-MAR-81 16:41")
(* One can call this on units by saying,
say, (UnGet (MAPCAR Units
(QUOTE GETPROPLIST))))
(MAPC (COND
((LISTP flag)
flag)
((NULL flag)
(OR GFNS EURFNS))
((LITATOM flag)
(LIST flag))
(T NIL))
(FUNCTION (LAMBDA (F)
(MAPC (PROG (tmp)
[SETQ tmp (ListsStarting (QUOTE GETPROP)
(COND
((CCODEP F)
(StrongUnsaveDef F)
(GETD F))
((GETD F))
((LISTP F)
F)
(T (WARNING
"In the process of UnGet-ting, found a function which was not an EXPR or SUBR!"]
[COND
(tmp ([LAMBDA (FF)
(AND (LITATOM F)
(MARKASCHANGED F))
(COND
(FF (CPRIN1 20 FF " ")
(CPRIN1 40 "(" (LENGTH tmp)
" changes.); "]
(COND
((LITATOM F)
F)
[(CAR (SOME Units (FUNCTION (LAMBDA (u)
(EQ F (GETPROPLIST u]
(T NIL]
(RETURN tmp))
(QUOTE DreplaceGet])
(UnionProp
[LAMBDA (A P V flag Kidding) (* edited: "26-APR-81 18:16")
(OR Kidding (MEMBER V (APPLY* P A))
(EQ (QUOTE Failed)
(CAR (LAST V)))
(ADDPROP A P V flag])
(UnionPropL
[LAMBDA (A P V flag Kidding) (* edited: "26-APR-81 18:16")
(OR Kidding (MAPC V (FUNCTION (LAMBDA (x)
(UnionProp A P x flag])
(Unitp
[LAMBDA (u) (* edited: "15-FEB-81 13:48")
(* u is a unit iff it has a Worth property
on its plist)
(Worth u])
(WaxOn
[LAMBDA (task) (* edited: "23-Mar-81 10:22")
(LIST (QUOTE It)
(QUOTE is)
(Certainty (CAR task))
(LIST (CAR task))
(QUOTE that)
(QUOTE finding)
(CADDR task)
(QUOTE of)
(CADR task)
(QUOTE will)
(QUOTE be)
(QUOTE worthwhile,)
(QUOTE since:)
([LAMBDA (re)
(COND
((NULL re)
(QUOTE (no good reason)))
((IGEQ (LENGTH re)
8)
(LIST (CAR re)
(QUOTE and)
(SUB1 (LENGTH re))
(QUOTE other)
(QUOTE reasons)))
(T re]
(CADDDR task])
(WholeTask
[LAMBDA (u s sup L) (* edited: "23-Mar-81 09:36")
(* Find a task on the agenda L which is to
work on slot s of unit u)
(CAR (SOME L (FUNCTION (LAMBDA (Z)
(AND (EQ u (ExtractUnitName Z))
(EQ s (ExtractSlotName Z))
(EQUAL (ASSOC (QUOTE SlotToChange)
sup)
(ASSOC (QUOTE SlotToChange)
(CurSup Z])
(WorkOnTask
[LAMBDA (task ArgU TaskResults TimeThen) (* edited: "18-MAY-81 14:33")
(SETQ AbortTask? NIL)
(SETQ TaskNum (ADD1 TaskNum))
(COND
((IGREATERP Verbosity 88)
(TERPRI)
(PRIN1 "Task ")
(PRIN1 TaskNum)
(PRIN1 ": ")
(PRIN1 "Working on the promising task ")
(PRIN1 task)
(TERPRI))
((IGREATERP Verbosity 10)
(CPRIN1 1 CRLF "Task " TaskNum ": Working on a new promising task: " (WaxOn task)
CRLF))
(T (CPRIN1 0 CRLF "Task " TaskNum CRLF)))
(SETQ CurPri (ExtractPriority task))
(SETQ ArgU task)
(SETQ CurUnit (ExtractUnitName task))
(SETQ CurSlot (ExtractSlotName task))
(SETQ CurVal (SETQ OldVal (APPLY* CurSlot CurUnit)))
(SETQ NewValues NIL)
(SETQ CurReasons (ExtractReasons task))
(SETQ CurSup (CurSup task))
(AND (IsAlto)
(SnazzyTask)
(SnazzyAgenda)
(SnazzyConcept T))
[OR [EVERY (SubSlots (QUOTE IfTaskParts))
(FUNCTION (LAMBDA (p)
(SETQ HeuristicAgenda (Examples (QUOTE Heuristic)))
(PROG (r)
HLOOP
(COND
(AbortTask? (RETURN NIL))
((NULL HeuristicAgenda)
(RETURN T)))
(SETQ r (CAR HeuristicAgenda))
(SETQ HeuristicAgenda (CDR HeuristicAgenda))
(COND
((NULL (APPLY* p r))
(GO HLOOP))
((SubsumedBy r)
(GO HLOOP))
([SELECTQ (APPLY* (APPLY* p r)
task)
(AbortTask (PUT r (QUOTE NAborts)
(ADD1 (OR (NAborts r)
0)))
(RETURN NIL))
(NIL NIL)
(AND (CPRIN1 66 " The " p " slot of heuristic " r (Abbrev r)
" applies to the current task. " CRLF)
(OR (AND (IsAlto)
(SnazzyHeuristic r p))
T)
(MyTime (QUOTE (EVERY (SubSlots (QUOTE ThenParts))
(QUOTE XeqIfItExists)))
(QUOTE TimeThen))
(OR (AND (IsAlto)
(SnazzyConcept T))
T)
(CPRIN1 68
" The Then Parts of the rule have been executed.
"
CRLF)
[SETQ TimRec (OR (OverallRecord r)
(PUT r (QUOTE OverallRecord)
(CONS 0 0]
(RPLACD TimRec (ADD1 (CDR TimRec)))
(RPLACA TimRec (IPLUS (CAR TimRec)
TimeThen]
(GO HLOOP))
(T (GO HLOOP)))
(GO HLOOP]
(SETQ TaskResults (AddPropL TaskResults (QUOTE Termination)
(QUOTE Aborted]
(CPRIN1 64 " The results of this task were: " TaskResults CRLF)
(CPRIN1 65 CRLF)
TaskResults])
(WorkOnTask
[LAMBDA (task ArgU TaskResults TimeThen) (* edited: "18-MAY-81 14:33")
(SETQ AbortTask? NIL)
(SETQ TaskNum (ADD1 TaskNum))
(COND
((IGREATERP Verbosity 88)
(TERPRI)
(PRIN1 "Task ")
(PRIN1 TaskNum)
(PRIN1 ": ")
(PRIN1 "Working on the promising task ")
(PRIN1 task)
(TERPRI))
((IGREATERP Verbosity 10)
(CPRIN1 1 CRLF "Task " TaskNum ": Working on a new promising task: " (WaxOn task)
CRLF))
(T (CPRIN1 0 CRLF "Task " TaskNum CRLF)))
(SETQ CurPri (ExtractPriority task))
(SETQ ArgU task)
(SETQ CurUnit (ExtractUnitName task))
(SETQ CurSlot (ExtractSlotName task))
(SETQ CurVal (SETQ OldVal (APPLY* CurSlot CurUnit)))
(SETQ NewValues NIL)
(SETQ CurReasons (ExtractReasons task))
(SETQ CurSup (CurSup task))
(AND (IsAlto)
(SnazzyTask)
(SnazzyAgenda)
(SnazzyConcept T))
[OR [EVERY (SubSlots (QUOTE IfTaskParts))
(FUNCTION (LAMBDA (p)
(SETQ HeuristicAgenda (Examples (QUOTE Heuristic)))
(PROG (r)
HLOOP
(COND
(AbortTask? (RETURN NIL))
((NULL HeuristicAgenda)
(RETURN T)))
(SETQ r (CAR HeuristicAgenda))
(SETQ HeuristicAgenda (CDR HeuristicAgenda))
(COND
((NULL (APPLY* p r))
(GO HLOOP))
((SubsumedBy r)
(GO HLOOP))
([SELECTQ (APPLY* (APPLY* p r)
task)
(AbortTask (PUT r (QUOTE NAborts)
(ADD1 (OR (NAborts r)
0)))
(RETURN NIL))
(NIL NIL)
(AND (CPRIN1 66 " The " p " slot of heuristic " r (Abbrev r)
" applies to the current task. " CRLF)
(OR (AND (IsAlto)
(SnazzyHeuristic r p))
T)
(MyTime (QUOTE (EVERY (SubSlots (QUOTE ThenParts))
(QUOTE XeqIfItExists)))
(QUOTE TimeThen))
(OR (AND (IsAlto)
(SnazzyConcept T))
T)
(CPRIN1 68
" The Then Parts of the rule have been executed.
"
CRLF)
[SETQ TimRec (OR (OverallRecord r)
(PUT r (QUOTE OverallRecord)
(CONS 0 0]
(RPLACD TimRec (ADD1 (CDR TimRec)))
(RPLACA TimRec (IPLUS (CAR TimRec)
TimeThen]
(GO HLOOP))
(T (GO HLOOP)))
(GO HLOOP]
(SETQ TaskResults (AddPropL TaskResults (QUOTE Termination)
(QUOTE Aborted]
(CPRIN1 64 " The results of this task were: " TaskResults CRLF)
(CPRIN1 65 CRLF)
TaskResults])
(WorkOnUnit
[LAMBDA (U TaskResults) (* edited: "18-MAY-81 17:39")
(SETQ TaskNum (ADD1 TaskNum))
(AND (IsAlto)
(PROGN [SnazzyTask (LIST (Worth U)
U
(QUOTE any)
(LIST (QUOTE (There are no great tasks on the Agenda now))
(CONS U
(QUOTE (has the highest Worth of any concept I haven't
focused on recently]
(SnazzyConcept T U)))
(COND
((IGREATERP Verbosity 10)
(TERPRI)
(PRIN1 "Task ")
(PRIN1 TaskNum)
(PRIN1 ": ")
(PRIN1 "Focusing on ")
(PRIN1 U)
(TERPRI)))
[MAPC (Examples (QUOTE Heuristic))
(FUNCTION (LAMBDA (H) (* try to apply H to unit U)
(APPLY* Interp H U]
(CPRIN1 65 CRLF)
(AND TaskResults (CPRIN1 64 " The results of this task so far are: " TaskResults CRLF))
(CPRIN1 65 CRLF)
(AND (IsAlto)
(SnazzyHeuristic NIL))
(CycleThruAgenda)
U])
(WorkOnUnit
[LAMBDA (U TaskResults) (* edited: "18-MAY-81 17:39")
(SETQ TaskNum (ADD1 TaskNum))
(AND (IsAlto)
(PROGN [SnazzyTask (LIST (Worth U)
U
(QUOTE any)
(LIST (QUOTE (There are no great tasks on the Agenda now))
(CONS U
(QUOTE (has the highest Worth of any concept I haven't
focused on recently]
(SnazzyConcept T U)))
(COND
((IGREATERP Verbosity 10)
(TERPRI)
(PRIN1 "Task ")
(PRIN1 TaskNum)
(PRIN1 ": ")
(PRIN1 "Focusing on ")
(PRIN1 U)
(TERPRI)))
[MAPC (Examples (QUOTE Heuristic))
(FUNCTION (LAMBDA (H) (* try to apply H to unit U)
(APPLY* Interp H U]
(CPRIN1 65 CRLF)
(AND TaskResults (CPRIN1 64 " The results of this task so far are: " TaskResults CRLF))
(CPRIN1 65 CRLF)
(AND (IsAlto)
(SnazzyHeuristic NIL))
(CycleThruAgenda)
U])
(WorthWorkingOn
[LAMBDA (task) (* edited: "18-MAR-81 12:21")
(IGEQ (ExtractPriority task)
MinPri])
(XeqIfItExists
[LAMBDA (s) (* edited: " 1-APR-81 13:56")
(* This is an aux fn of rule interpreters. We assume that the interpreter is being
run on a rule called r, which is to be applied to a unit ArgU)
(* This function evaluates the s part of
r, which is presumably a Then- part of
some sort)
([LAMBDA (z TimeX TimRec)
(COND
((NULL z)
T)
((MyTime (QUOTE (APPLY* z ArgU))
(QUOTE TimeX))
(CPRIN1 80 TAB TAB "the " s " slot of " r " has been applied successfully to " ArgU CRLF)
[SETQ TimRec (OR (APPLY* (CAR (Record s))
r)
(PUT r (CAR (Record s))
(CONS 0 0]
(RPLACD TimRec (ADD1 (CDR TimRec)))
(RPLACA TimRec (IPLUS (CAR TimRec)
TimeX))
T)
(T [SETQ TimRec (OR (APPLY* (CAR (FailedRecord s))
r)
(PUT r (CAR (FailedRecord s))
(CONS 0 0]
(RPLACD TimRec (ADD1 (CDR TimRec)))
(RPLACA TimRec (IPLUS (CAR TimRec)
TimeX))
(CPRIN1 75 TAB TAB "the " s " slot of " r " was applied to " ArgU
", but for some reason it signalled a failure."
CRLF)
NIL]
(APPLY* s r])
(YesNo
[LAMBDA (i prompt) (* edited: " 2-MAR-81 10:47")
(AND prompt (NULL i)
(PRIN1 CRLF TTY)
(PRIN1 prompt TTY)
(PRIN1 " (Y or N): " TTY))
(MEMB (OR i (RATOM TTY))
(QUOTE (Y Yes YES y yes])
(ZeroRecords
[LAMBDA (H) (* edited: "28-APR-81 01:49")
(* remove all properties of the form
---Record)
[MAPC (Examples (QUOTE RecordSlots))
(FUNCTION (LAMBDA (S)
(REMPROP H S]
(QUOTE %.])
)
(RPAQQ Units (IntApplics MultEleStrucInsert H29 H28 H27 H26 H25 Rarity WhyInt H24 H23 IsAInt
IntExamples LessInteresting MoreInteresting H22 Interestingness Restrictions
Extensions OpCatByNArgs PredCatByNArgs TertiaryPred UnaryPred BinaryPred
HigherArity LowerArity NonEmptyStruc EmptyStruc SetOfSets
StructureOfStructures TruthValue Atom Implies NOT LogicOp Relation
SetOfOPairs InvertOp InvertedOp Restrict Identity1 Proj3of3 Proj2of3
Proj1of3 Proj2 Proj1 MEMB MEMBER AllButLast LastEle AllButThird AllButSecond
AllButFirst ThirdEle SecondEle FirstEle ReverseOPair Pair OPair
ParallelJoin2 ParallelJoin Repeat2 TertiaryOp Repeat BinaryOp
ParallelReplace2 EachElementIsA UnaryOp TypeOfStructure ParallelReplace
Coalesce BagDifference OSetDifference ListDifference SetDifference
StrucDifference BagUnion ListUnion OSetUnion StrucUnion BagIntersect
OSetIntersect ListIntersect StrucIntersect SetUnion SetIntersect OrdStrucOp
OrdStrucEqual BagEqual ListEqual OSetEqual SufDefn NecDefn UnOrdStruc
OrdStruc NoMultEleStruc OSetDelete OSetOp OSetInsert OSet
MultEleStrucDelete1 MultEleStrucOp MultEleStruc BagDelete1 BagDelete BagOp
BagInsert Bag ListDelete1 ListDelete List ListInsert ListOp SetDelete
SetInsert StrucDelete StrucOp StrucInsert AND Abbrev Add Alg AlwaysNIL
AlwaysNIL2 AlwaysT AlwaysT2 Anything ApplicGenerator Applics Arity
BestChoose BestSubset Bit Category CompiledDefn Compose Conjecture
ConjectureAbout Conjectures ConstantBinaryPred ConstantPred
ConstantUnaryPred Creditors CriterialSlot DataType Defn DirectApplics
DivisorsOf Domain DontCopy DoubleCheck EQ EQUAL ElimSlots English EvenNum
Examples FailedRecord FailedRecordFor FastAlg FastDefn Format
Generalizations Generator GoodChoose GoodSubset H1 H10 H11 H12 H13 H14 H15
H16 H17 H18 H19 H19Criterial H2 H20 H21 H3 H4 H5 H5Criterial H5Good H6 H7 H8
H9 HAvoid HAvoid2 HAvoid2AND HAvoid3 HAvoid3First HAvoidIfWorking Heuristic
HindSightRule IEQP IGEQ IGREATERP ILEQ ILESSP IfAboutToWorkOnTask
IfFinishedWorkingOnTask IfParts IfPotentiallyRelevant IfTaskParts
IfTrulyRelevant IfWorkingOnTask InDomainOf IndirectApplics Inverse IsA
IsRangeOf IterativeAlg IterativeDefn MathConcept MathObj MathOp MathPred
Multiply NNumber NonCriterialSlot NonExamples NumOp OR OddNum Op
OverallRecord PerfNum PerfSquare Pred PrimeNum ProtoConjec RandomChoose
RandomSubset Range Record RecordFor RecordSlot RecursiveAlg RecursiveDefn
ReprConcept Set SetEqual SetOfNumbers SetOp SibSlots Slot Specializations
Square StrucEqual Structure SubSlots Subsetp SubsumedBy Subsumes Successor
SuperSlots Task TheFirstOf TheSecondOf ThenAddToAgenda
ThenAddToAgendaFailedRecord ThenAddToAgendaRecord ThenCompute
ThenComputeFailedRecord ThenComputeRecord ThenConjecture
ThenConjectureFailedRecord ThenConjectureRecord ThenDefineNewConcepts
ThenDefineNewConceptsFailedRecord ThenDefineNewConceptsRecord
ThenDeleteOldConcepts ThenDeleteOldConceptsFailedRecord
ThenDeleteOldConceptsRecord ThenModifySlots ThenModifySlotsFailedRecord
ThenModifySlotsRecord ThenParts ThenPrintToUser ThenPrintToUserFailedRecord
ThenPrintToUserRecord ToDelete ToDelete1 Transpose UnaryUnitOp Undefined
UndefinedPred Unit UnitOp UnitizedAlg UnitizedDefn Worth los1 los2 los3 los4
los5 los6 los7 win1))
(PUTPROPS IntApplics Worth 500
IsA (Slot NonCriterialSlot ReprConcept Anything)
DataType Unit
DoubleCheck T
DontCopy T
SuperSlots (Applics)
LessInteresting (Applics))
(PUTPROPS MultEleStrucInsert Worth 500
IsA (MathConcept MathOp Op Anything StrucOp MultEleStrucOp BinaryOp)
Arity 2
Domain (Anything MultEleStruc)
Range (MultEleStruc)
ElimSlots (Applics)
Specializations (ListInsert BagInsert)
FastAlg CONS)
(PUTPROPS H29 IsA (Heuristic Op Anything)
English (IF the current task is to find examples of a structure which can have
multiple elements, and some are known already, THEN get new ones by
mutating the multiplicities of some of the elements of those known
structures)
IfPotentiallyRelevant NULL
Worth 500
Abbrev (New examples of a kind of MultEleStruc can be found by permuting
multiplicities of elements of already-known examples)
IfWorkingOnTask [LAMBDA (task)
(AND (IsAKindOf CurUnit (QUOTE MultEleStruc))
(IsAKindOf CurSlot (QUOTE Examples))
(SETQ SpaceToUse (SETQ CurVal (APPLY* CurSlot CurUnit]
IfFinishedWorkingOnTask [LAMBDA (task)
(AND (IsAKindOf CurUnit (QUOTE MultEleStruc))
(IsAKindOf CurSlot (QUOTE Examples))
(SETQ SpaceToUse (SETQ CurVal (APPLY* CurSlot
CurUnit]
ThenPrintToUser [LAMBDA (task)
(CPRIN1 13 CRLF
"Modified multiplicities of elements of examples of "
CurUnit
(QUOTE s)
" and as a result added "
(LENGTH NewValues)
" new examples." CRLF)
(CPRIN1 48 " Namely: " NewValues CRLF)
T]
ThenCompute [LAMBDA (task)
[MAPC SpaceToUse (FUNCTION
(LAMBDA (ex ex2)
(SETQ ex2 (APPEND ex))
[MAPC (APPEND ex)
(FUNCTION (LAMBDA
(e)
(COND ((Randomp)
NIL)
((Randomp)
(SETQ
ex2
(RunAlg (QUOTE
MultEleStrucInsert)
e ex2)))
((Randomp)
(SETQ
ex2
(RunAlg (QUOTE
MultEleStrucDelete1)
e ex2)))
(T NIL]
(UnionProp CurUnit CurSlot ex2]
(AND (SETQ NewValues (SetDifference (Examples CurUnit)
CurVal))
(SETQ TaskResults (CONS [LIST (QUOTE NewValues)
(LIST CurUnit CurSlot
NewValues
(LIST (QUOTE By)
(QUOTE changing)
(QUOTE
multiplicities)
(QUOTE of)
(QUOTE elements)
(QUOTE of)
(QUOTE examples)
(QUOTE of)
CurUnit
(QUOTE Eurisko)
(QUOTE may)
(QUOTE have)
(QUOTE doubled)
(QUOTE the)
(QUOTE number)
(QUOTE of)
(QUOTE such)
(QUOTE examples]
TaskResults]
Arity 1)
(PUTPROPS H28 IsA (Heuristic Anything Op)
English (IF the unit being focused on is a very interesting unary predicate, THEN
study the set of items upon which it fails to hold)
IfPotentiallyRelevant [LAMBDA (f)
(AND (MEMB (QUOTE UnaryPred)
(IsA f))
(OR (HasHighWorth f)
(IsAInt f]
Worth 500
Abbrev (Define the set of domain elements failing a given unary predicate)
Arity 1
ThenPrintToUser [LAMBDA (task)
(CPRIN1 13 CRLF "Defined the subcategory of "
(CAR (Domain f))
(QUOTE s)
" which fail to satisfy the unary predicate " f CRLF]
ThenDefineNewConcepts [LAMBDA (f)
(SETQ NewUnit (CreateUnit (PACK* (QUOTE FailingSetFor)
f)))
(PUT NewUnit Worth (AverageWorths f (QUOTE H28)))
(SETQ TaskResults (AddPropL TaskResults (QUOTE NewUnits)
NewUnit))
(ADDPROP
(QUOTE H28)
(QUOTE Applics)
(LIST (LIST (QUOTE TaskNum:)
TaskNum task (DATE))
(LIST NewUnit)
(InitializeCreditAssignment)
(LIST (QUOTE Defined)
(QUOTE failing)
(QUOTE (PACK* (CAR (Domain f))
(QUOTE s)))
(QUOTE for)
(QUOTE unary)
(QUOTE predicate)
f)))
[MAPC (SETQ Creditors (CDR (ASSOC (QUOTE CreditTo)
CurSup)))
(FUNCTION (LAMBDA
(H)
(ADDPROP H (QUOTE Applics)
(LIST (LIST (QUOTE TaskNum:)
TaskNum task
(DATE))
(LIST NewUnit)
(
DecrementCreditAssignment]
(PUT NewUnit (QUOTE Creditors)
(SETQ Creditors (CONS (QUOTE H28)
Creditors)))
[PUT NewUnit (QUOTE Generalizations)
(CONS (QUOTE (CAR (Domain f)))
(COPY (Generalizations
(QUOTE (CAR (Domain f]
[PUT NewUnit (QUOTE IsA)
(COPY (IsA (QUOTE (CAR (Domain f]
[PUT NewUnit (QUOTE FastDefn)
(LIST (QUOTE LAMBDA)
(QUOTE (e))
(LIST (QUOTE AND)
(LIST (QUOTE RunDefn)
(KWOTE (CAR (Domain f)))
(QUOTE e))
(LIST (QUOTE MEMB)
(LIST (QUOTE RunAlg)
(KWOTE f)
(QUOTE e))
(QUOTE FailureList]
(AddInv NewUnit)
T])
(PUTPROPS H27 IsA (Heuristic Anything Op)
English (IF the unit being focused on is a very interesting unary predicate, THEN
study the set of items upon which it holds)
IfPotentiallyRelevant [LAMBDA (f)
(AND (MEMB (QUOTE UnaryPred)
(IsA f))
(OR (HasHighWorth f)
(IsAInt f]
Worth 500
Abbrev (Define the set of domain elements satisfying a given unary predicate)
Arity 1
ThenPrintToUser [LAMBDA (task)
(CPRIN1 13 CRLF "Defined the subcategory of "
(CAR (Domain f))
(QUOTE s)
" which satisfy the unary predicate " f CRLF]
ThenDefineNewConcepts [LAMBDA
(f)
(SETQ NewUnit (CreateUnit (PACK* (QUOTE SatisfyingSetFor)
f)))
(PUT NewUnit Worth (AverageWorths f (QUOTE H27)))
(SETQ TaskResults (AddPropL TaskResults (QUOTE NewUnits)
NewUnit))
(ADDPROP (QUOTE H27)
(QUOTE Applics)
(LIST (LIST (QUOTE TaskNum:)
TaskNum task (DATE))
(LIST NewUnit)
(InitializeCreditAssignment)
(LIST (QUOTE Defined)
(QUOTE satisfying)
(QUOTE (PACK* (CAR (Domain f))
(QUOTE s)))
(QUOTE for)
(QUOTE unary)
(QUOTE predicate)
f)))
[MAPC (SETQ Creditors (CDR (ASSOC (QUOTE CreditTo)
CurSup)))
(FUNCTION (LAMBDA (H)
(ADDPROP H (QUOTE Applics)
(LIST (LIST (QUOTE TaskNum:)
TaskNum task
(DATE))
(LIST NewUnit)
(
DecrementCreditAssignment]
(PUT NewUnit (QUOTE Creditors)
(SETQ Creditors (CONS (QUOTE H27)
Creditors)))
[PUT NewUnit (QUOTE Generalizations)
(CONS (QUOTE (CAR (Domain f)))
(COPY (Generalizations (QUOTE (CAR (Domain f]
[PUT NewUnit (QUOTE IsA)
(COPY (IsA (QUOTE (CAR (Domain f]
[PUT NewUnit (QUOTE FastDefn)
(LIST (QUOTE LAMBDA)
(QUOTE (e))
(APPEND (LIST (QUOTE AND)
(LIST (QUOTE RunDefn)
(KWOTE (CAR (Domain f)))
(QUOTE e))
(LIST (QUOTE RunAlg)
(KWOTE f)
(QUOTE e]
(AddInv NewUnit)
T])
(PUTPROPS H26 IsA (Heuristic Anything Op)
English (IF the unit being focused on is a very interesting predicate, THEN study the
set of tuples upon which it fails to hold)
IfPotentiallyRelevant [LAMBDA (f)
(AND (MEMB (QUOTE Pred)
(IsA f))
(OR (HasHighWorth f)
(IsAInt f]
Worth 500
Abbrev (Define the set of tuples failing to satisfy a given predicate)
Arity 1
ThenPrintToUser [LAMBDA (task)
(CPRIN1 13 CRLF
"Defined the set of entities failing to satisfy predicate "
f CRLF)
(CPRIN1 41 tab "I.e., those lists whose format is "
(Domain f)
", and which cause " f " to return a null value."
CRLF]
ThenDefineNewConcepts [LAMBDA
(f)
(SETQ NewUnit (CreateUnit (PACK* (QUOTE FailingSetFor)
f)))
(PUT NewUnit Worth (AverageWorths f (QUOTE H26)))
(SETQ TaskResults (AddPropL TaskResults (QUOTE NewUnits)
NewUnit))
(ADDPROP (QUOTE H26)
(QUOTE Applics)
(LIST (LIST (QUOTE TaskNum:)
TaskNum task (DATE))
(LIST NewUnit)
(InitializeCreditAssignment)
(LIST (QUOTE Defined)
(QUOTE failing)
(QUOTE set)
(QUOTE for)
(QUOTE predicate)
f)))
[MAPC (SETQ Creditors (CDR (ASSOC (QUOTE CreditTo)
CurSup)))
(FUNCTION (LAMBDA (H)
(ADDPROP H (QUOTE Applics)
(LIST (LIST (QUOTE TaskNum:)
TaskNum task
(DATE))
(LIST NewUnit)
(
DecrementCreditAssignment]
(PUT NewUnit (QUOTE Creditors)
(SETQ Creditors (CONS (QUOTE H26)
Creditors)))
[PUT NewUnit (QUOTE Generalizations)
(CONS (QUOTE List)
(COPY (Generalizations (QUOTE List]
[PUT NewUnit (QUOTE IsA)
(COPY (IsA (QUOTE List]
[PUT NewUnit (QUOTE FastDefn)
(LIST (QUOTE LAMBDA)
(QUOTE (l))
(APPEND [LIST (QUOTE AND)
(QUOTE (RunDefn (QUOTE List)
l))
(LIST (QUOTE EQ)
(QUOTE (LENGTH l))
(LENGTH (Domain f]
[MAP2CAR (Domain f)
(QUOTE (CAR CADR CADDR CADDDR
CADDDDR CADDDDDR
CADDDDDDR))
(FUNCTION
(LAMBDA
(d cr)
(LIST (QUOTE RunDefn)
(KWOTE d)
(LIST cr (QUOTE l]
(LIST (LIST (QUOTE MEMB)
(LIST (QUOTE ApplyAlg)
(KWOTE f)
(QUOTE l))
(QUOTE FailureList]
(AddInv NewUnit)
T])
(PUTPROPS H25 IsA (Heuristic Anything Op)
English (IF the unit being focused on is a very interesting predicate, THEN study the
set of tuples upon which it holds)
IfPotentiallyRelevant [LAMBDA (f)
(AND (MEMB (QUOTE Pred)
(IsA f))
(OR (HasHighWorth f)
(IsAInt f]
Worth 500
Abbrev (Define the set of tuples satisfying a given predicate)
Arity 1
ThenPrintToUser [LAMBDA (task)
(CPRIN1 13 CRLF
"Defined the set of entities satisfying predicate "
f CRLF)
(CPRIN1 41 tab "I.e., those lists whose format is "
(Domain f)
", and which cause " f " to return a non-null value."
CRLF]
ThenDefineNewConcepts [LAMBDA
(f)
(SETQ NewUnit (CreateUnit (PACK* (QUOTE SatisfyingSetFor)
f)))
(PUT NewUnit Worth (AverageWorths f (QUOTE H25)))
(SETQ TaskResults (AddPropL TaskResults (QUOTE NewUnits)
NewUnit))
(ADDPROP (QUOTE H25)
(QUOTE Applics)
(LIST (LIST (QUOTE TaskNum:)
TaskNum task (DATE))
(LIST NewUnit)
(InitializeCreditAssignment)
(LIST (QUOTE Defined)
(QUOTE satisfying)
(QUOTE set)
(QUOTE for)
(QUOTE predicate)
f)))
[MAPC (SETQ Creditors (CDR (ASSOC (QUOTE CreditTo)
CurSup)))
(FUNCTION (LAMBDA (H)
(ADDPROP H (QUOTE Applics)
(LIST (LIST (QUOTE TaskNum:)
TaskNum task
(DATE))
(LIST NewUnit)
(
DecrementCreditAssignment]
(PUT NewUnit (QUOTE Creditors)
(SETQ Creditors (CONS (QUOTE H25)
Creditors)))
[PUT NewUnit (QUOTE Generalizations)
(CONS (QUOTE List)
(COPY (Generalizations (QUOTE List]
[PUT NewUnit (QUOTE IsA)
(COPY (IsA (QUOTE List]
[PUT NewUnit (QUOTE FastDefn)
(LIST (QUOTE LAMBDA)
(QUOTE (l))
(APPEND [LIST (QUOTE AND)
(QUOTE (RunDefn (QUOTE List)
l))
(LIST (QUOTE EQ)
(QUOTE (LENGTH l))
(LENGTH (Domain f]
[MAP2CAR (Domain f)
(QUOTE (CAR CADR CADDR CADDDR
CADDDDR CADDDDDR
CADDDDDDR))
(FUNCTION
(LAMBDA
(d cr)
(LIST (QUOTE RunDefn)
(KWOTE d)
(LIST cr (QUOTE l]
(LIST (LIST (QUOTE ApplyAlg)
(KWOTE f)
(QUOTE l]
(AddInv NewUnit)
T])
(PUTPROPS Rarity Worth 500
IsA (Slot NonCriterialSlot ReprConcept Anything)
DataType Number
DontCopy T
Format (frequency-True number-T number-F))
(PUTPROPS WhyInt Worth 300
IsA (Slot NonCriterialSlot ReprConcept Anything)
DataType Text
DoubleCheck T
DontCopy T)
(PUTPROPS H24 IsA (Heuristic Op Anything)
English (IF trying to see if a category is interesting, THEN see if all its examples
satisfy the same, interesting, preferably rare predicate)
IfPotentiallyRelevant [LAMBDA
(f)
(* Note this is one of the rare rules which is used both to
see if a unit f is interesting, via WorkOnUnit and via
WorkOnTask)
(AND (MEMB (QUOTE Category)
(IsA f))
[SETQ
SpaceToUse
(SUBSET (Examples (QUOTE UnaryPred))
(FUNCTION
(LAMBDA
(P)
(AND [OR (HasHighWorth P)
(MEMB P (IntExamples
(QUOTE UnaryPred]
(LEQNN (CAR (Rarity P))
.3]
(IGEQ (LENGTH (Examples CurUnit))
4)
(SETQ CurUnit f)
(SETQ CurSlot (QUOTE WhyInt]
Worth 500
Abbrev (See if all examples of a category satisfy the same interesting predicate)
IfWorkingOnTask [LAMBDA (task)
(AND (IsAKindOf CurSlot (QUOTE WhyInt))
(MEMB (QUOTE Category)
(IsA CurUnit))
[SETQ
SpaceToUse
(SUBSET (Examples (QUOTE UnaryPred))
(FUNCTION
(LAMBDA
(P)
(AND [OR (HasHighWorth P)
(MEMB P (IntExamples
(QUOTE UnaryPred]
(LEQNN (CAR (Rarity P))
.3]
(IGEQ (LENGTH (Examples CurUnit))
4]
ThenPrintToUser [LAMBDA (task)
(CPRIN1 13 CRLF "Of the " (LENGTH SpaceToUse)
" predicates we tried, "
(LENGTH Reas)
" were found to hold on all examples of " CurUnit
", thereby making it interesting."
CRLF)
(CPRIN1 40 " Namely, " Reas CRLF)
T]
ThenCompute [LAMBDA (task)
[SETQ Reas (SUBSET SpaceToUse (FUNCTION
(LAMBDA (P)
(* See if all examples of CurUnit
satisfy predicate P)
(EVERY (Examples CurUnit)
(FUNCTION (LAMBDA
(x)
(RunAlg P x]
(UnionPropL CurUnit CurSlot Reas)
Reas]
Arity 1)
(PUTPROPS H23 IsA (Heuristic Op Anything)
English (IF the current task is to find interesting examples of a unit, and it has
some known examples already, THEN look over examples of the unit, and see
if any of them are interesting)
IfPotentiallyRelevant NULL
Worth 700
Abbrev (Some exs (u)
may be interesting)
IfWorkingOnTask [LAMBDA (task)
(AND (IsAKindOf CurSlot (QUOTE IntExamples))
(SETQ DefnToUse (Interestingness CurUnit))
(SETQ SpaceToUse (Examples CurUnit]
ThenPrintToUser [LAMBDA (task)
(CPRIN1 13 CRLF "Found " (LENGTH NewValues)
" of the "
(LENGTH (Examples CurUnit))
" examples of " CurUnit " to be interesting." CRLF)
(CPRIN1 48 " Namely: " NewValues CRLF)
T]
ThenCompute [LAMBDA (task)
(SETQ CurVal (APPLY* CurSlot CurUnit))
[MAPC SpaceToUse (FUNCTION (LAMBDA (Z)
(COND
((APPLY* DefnToUse Z)
(CPRIN1 55 (QUOTE +))
(UnionProp CurUnit
(QUOTE
IntExamples)
Z)
T)
(T (CPRIN1 56 (QUOTE -))
NIL]
(AND (SETQ NewValues (SetDifference (APPLY* CurSlot CurUnit)
CurVal))
(SETQ TaskResults (CONS (LIST (QUOTE NewValues)
(LIST CurUnit CurSlot
NewValues
(LIST (QUOTE By)
(QUOTE examining)
(QUOTE Examples)
(QUOTE of)
CurUnit
(QUOTE ,)
(QUOTE Eurisko)
(QUOTE found)
(LENGTH NewValues)
(QUOTE of)
(QUOTE them)
(QUOTE were)
(QUOTE also)
CurSlot
(QUOTE of)
CurUnit)))
TaskResults]
Arity 1)
(PUTPROPS IsAInt Worth 300
Inverse (IntExamples)
DataType Unit
DoubleCheck T
IsA (Slot NonCriterialSlot ReprConcept Anything))
(PUTPROPS IntExamples Worth 500
IsA (Slot NonCriterialSlot ReprConcept Anything)
DataType Unit
DoubleCheck T
DontCopy T
SuperSlots (Examples)
Inverse (IsAInt)
LessInteresting (Examples))
(PUTPROPS LessInteresting Worth 300
IsA (Slot NonCriterialSlot ReprConcept Anything)
DataType Unit
Inverse (MoreInteresting))
(PUTPROPS MoreInteresting Worth 300
IsA (Slot NonCriterialSlot ReprConcept Anything)
DataType Unit
Inverse (LessInteresting))
(PUTPROPS H22 IsA (Heuristic Op Anything)
English (IF instances of a unit have been found, THEN place a task on the Agenda to
see if any of them are unusually interesting)
IfPotentiallyRelevant NULL
Worth 500
Abbrev (Check instances of a unit for gems)
IfFinishedWorkingOnTask [LAMBDA (task)
(AND (IsAKindOf CurSlot (Instances CurUnit))
(Interestingness CurUnit)
(APPLY* CurSlot CurUnit]
ThenPrintToUser [LAMBDA (task)
(CPRIN1 13
"A new task was added to the agenda, to see which of the "
(LENGTH (Examples CurUnit))
" are interesting ones." CRLF)
T]
ThenAddToAgenda [LAMBDA (task)
(SETQ Agenda (MergeTasks
[LIST (LIST (AverageWorths CurUnit (QUOTE H22))
CurUnit
(CAR (MoreInteresting (Instances CurUnit))
)
(LIST
"Now that instances of a unit have been found, see if any are unusually interesting")
(LIST (QUOTE CreditTo)
(QUOTE H22]
Agenda))
(SETQ TaskResults
(AddPropL TaskResults (QUOTE NewTasks)
(QUOTE (1 unit's instances must be evaluated
for Interestingness]
Arity 1
ThenAddToAgendaRecord (14 . 1)
ThenPrintToUserRecord (38 . 1)
OverallRecord (75 . 1))
(PUTPROPS Interestingness Worth 300
IsA (Slot NonCriterialSlot ReprConcept Anything)
DataType LispPred
DoubleCheck T
Abbrev (What would make an instance of this unit interesting?)
English (What features or properties would an example or applic of this
unit possess which would make it unusually interesting?))
(PUTPROPS Restrictions Worth 300
IsA (Slot NonCriterialSlot ReprConcept Anything)
DataType Unit
DoubleCheck T
Inverse (Extensions)
SuperSlots (Specializations))
(PUTPROPS Extensions Worth 300
IsA (Slot NonCriterialSlot ReprConcept Anything)
DataType Unit
DoubleCheck T
Inverse (Restrictions)
SuperSlots (Generalizations))
(PUTPROPS OpCatByNArgs Worth 500
IsA (Category Anything ReprConcept)
Examples (UnaryPred BinaryPred TertiaryPred UnaryOp BinaryOp TertiaryOp)
Generalizations (Category)
Specializations (PredCatByNArgs))
(PUTPROPS PredCatByNArgs Worth 500
IsA (Category Anything ReprConcept)
Examples (UnaryPred BinaryPred TertiaryPred)
Generalizations (Category OpCatByNArgs))
(PUTPROPS TertiaryPred LowerArity (BinaryPred)
Worth 500
Generalizations (TertiaryOp Pred Op Anything)
IsA (ReprConcept Anything Category PredCatByNArgs OpCatByNArgs)
FastDefn [LAMBDA (f)
(AND (MEMB (QUOTE Pred)
(IsA f))
(EQ 3 (Arity f]
Rarity (.1827957 17 76))
(PUTPROPS UnaryPred Worth 500
HigherArity (BinaryPred)
Generalizations (UnaryOp Pred Op Anything)
IsA (ReprConcept Anything Category PredCatByNArgs OpCatByNArgs)
Examples (AlwaysT AlwaysNIL ConstantUnaryPred UndefinedPred NOT)
FastDefn [LAMBDA (f)
(AND (MEMB (QUOTE Pred)
(IsA f))
(EQ 1 (Arity f]
Rarity (.1182796 11 82))
(PUTPROPS BinaryPred Worth 500
LowerArity (UnaryPred)
HigherArity (TertiaryPred)
Generalizations (BinaryOp Pred Op Anything)
IsA (ReprConcept Anything Category PredCatByNArgs OpCatByNArgs)
Examples (EQUAL IEQP EQ ILEQ IGEQ ILESSP IGREATERP AND OR TheSecondOf
TheFirstOf StrucEqual SetEqual Subsetp ConstantBinaryPred
AlwaysT2 AlwaysNIL2 OSetEqual BagEqual ListEqual MEMBER MEMB
Implies)
FastDefn [LAMBDA (f)
(AND (MEMB (QUOTE Pred)
(IsA f))
(EQ 2 (Arity f]
IntExamples (IEQP EQ StrucEqual SetEqual OSetEqual BagEqual ListEqual MEMB
MEMBER)
Rarity (.07526882 7 86))
(PUTPROPS HigherArity Worth 300
IsA (Slot NonCriterialSlot ReprConcept Anything)
DataType Unit
Inverse (LowerArity))
(PUTPROPS LowerArity Worth 300
IsA (Slot NonCriterialSlot ReprConcept Anything)
DataType Unit
Inverse (HigherArity))
(PUTPROPS NonEmptyStruc Worth 500
IsA (MathConcept MathObj Anything Category TypeOfStructure)
Generalizations (Structure Anything Set List Bag MultEleStruc OSet
NoMultEleStruc OrdStruc UnOrdStruc Pair OPair)
FastDefn LISTP
Examples NIL)
(PUTPROPS EmptyStruc Worth 500
IsA (MathConcept MathObj Anything Category TypeOfStructure)
Generalizations (Structure Anything Set List Bag MultEleStruc OSet
NoMultEleStruc OrdStruc UnOrdStruc)
FastDefn NULL
ElimSlots (Examples))
(PUTPROPS SetOfSets IsA (MathConcept MathObj Anything Category)
Worth 500
UnitizedDefn [LAMBDA (s)
(AND (RunDefn (QUOTE Set)
s)
(EVERY s (FUNCTION (LAMBDA (n)
(RunDefn (QUOTE Set)
n]
ElimSlots (Examples)
Generalizations (Anything StructureOfStructures)
EachElementIsA Set
Specializations (Relation))
(PUTPROPS StructureOfStructures IsA (MathConcept MathObj Anything Category)
Worth 500
UnitizedDefn [LAMBDA (s)
(AND (RunDefn (QUOTE Structure)
s)
(EVERY s (FUNCTION (LAMBDA
(n)
(RunDefn
(QUOTE Structure)
n]
ElimSlots (Examples)
Generalizations (Anything)
EachElementIsA Structure
Specializations (SetOfOPairs SetOfSets))
(PUTPROPS TruthValue Generalizations (Anything Atom)
Worth 500
IsA (Anything Category MathObj)
FastDefn [LAMBDA (X)
(OR (EQ X NIL)
(EQ X T]
Examples (T NIL))
(PUTPROPS Atom Generalizations (Anything)
Worth 500
IsA (Anything Category ReprConcept)
FastDefn ATOM
Specializations (TruthValue))
(PUTPROPS Implies Worth 500
IsA (Op Pred MathOp MathPred Anything BinaryOp LogicOp BinaryPred)
Arity 2
Domain (Anything Anything)
Range (Anything)
ElimSlots (Applics)
FastAlg [LAMBDA (X Y)
(OR (NULL X)
Y]
UnitizedAlg [LAMBDA (X Y)
(RunAlg (QUOTE OR)
(RunAlg (QUOTE NOT)
X)
Y])
(PUTPROPS NOT Worth 500
IsA (Op Pred MathOp MathPred Anything UnaryOp LogicOp UnaryPred)
Arity 1
Domain (Anything)
Range (Bit)
ElimSlots (Applics)
FastAlg NOT)
(PUTPROPS LogicOp Generalizations (MathConcept Op MathOp Anything StrucOp)
Worth 500
IsA (MathConcept MathObj Anything Category)
Abbrev (Logical Operations)
Examples (AND OR TheFirstOf TheSecondOf NOT Implies))
(PUTPROPS Relation IsA (MathConcept MathObj Anything Category)
Worth 500
UnitizedDefn [LAMBDA (s)
(AND (RunDefn (QUOTE Set)
s)
(EVERY s (FUNCTION (LAMBDA (n)
(RunDefn OPair n]
ElimSlots (Examples)
Generalizations (Anything SetOfOPairs SetOfSets)
EachElementIsA OPair)
(PUTPROPS SetOfOPairs IsA (MathConcept MathObj Anything Category)
Worth 500
UnitizedDefn [LAMBDA (s)
(AND (RunDefn (QUOTE Set)
s)
(EVERY s (FUNCTION (LAMBDA (n)
(RunDefn (QUOTE OPair)
n]
ElimSlots (Examples)
Generalizations (Anything StructureOfStructures)
EachElementIsA OPair
Specializations (Relation))
(PUTPROPS InvertOp Worth 100
IsA (MathConcept MathOp Op Anything UnaryOp)
Arity 1
Domain (Op)
Range (InvertedOp)
ElimSlots (Applics))
(PUTPROPS InvertedOp Generalizations (MathConcept Op MathOp Anything)
Worth 500
IsA (MathConcept MathObj Anything Category)
Abbrev (Operations which were formed via InvertOp)
IsRangeOf (InvertOp))
(PUTPROPS Restrict Worth 600
IsA (MathConcept MathOp Op Anything UnaryOp)
Arity 1
Domain (Op)
Range (Op)
ElimSlots (Applics)
FastAlg [LAMBDA (f nam newdom fargs)
(COND ([AND [SETQ garg (RandomChoose (SUBSET (Domain f)
(QUOTE
Specializations]
(SETQ newdom (RandomSubst (RandomChoose
(Specializations garg))
garg
(Domain f)))
(NOT (EQUAL newdom (Domain f]
(SETQ nam (CreateUnit (PACK* (QUOTE Restric)
f)))
(PUT nam (QUOTE IsA)
(COPY (IsA f)))
(PUT nam (QUOTE Worth)
(AverageWorths (QUOTE Restrict)
f))
(PUT nam (QUOTE Arity)
(Arity f))
(SETQ fargs
(MAP2CAR (Domain f)
(QUOTE (u v w x y z z2 z3 z4 z5))
(QUOTE TheSecondOf)))
(PUT nam (QUOTE Domain)
newdom)
(PUT nam (QUOTE Range)
(COPY (Range f)))
[PUT nam (QUOTE UnitizedAlg)
(LIST (QUOTE LAMBDA)
fargs
(CONS (QUOTE RunAlg)
(CONS (KWOTE f)
fargs]
(PUT nam (QUOTE Extensions)
(LIST f))
(PUT nam (QUOTE ElimSlots)
(LIST (QUOTE Applics)))
(PUT nam (QUOTE Creditors)
(LIST (QUOTE Restrict)))
(AddInv nam)
nam)
(T (* we should check for cases where 2 domain components
of f have a common nontrivial specialization)
(QUOTE Failed])
(PUTPROPS Identity1 Worth 500
IsA (MathConcept MathOp Op Anything UnaryOp)
Arity 1
Domain (Anything)
Range (Anything)
ElimSlots (Applics)
FastAlg [LAMBDA (X)
X]
Generalizations (Proj1 Proj2 Proj1of3 Proj2of3 Proj3of3))
(PUTPROPS Proj3of3 Worth 500
IsA (MathConcept MathOp Op Anything TertiaryOp)
Arity 3
Domain (Anything Anything Anything)
Range (Anything)
ElimSlots (Applics)
FastAlg [LAMBDA (X Y Z)
Z]
Specializations (Identity1))
(PUTPROPS Proj2of3 Worth 500
IsA (MathConcept MathOp Op Anything TertiaryOp)
Arity 3
Domain (Anything Anything Anything)
Range (Anything)
ElimSlots (Applics)
FastAlg [LAMBDA (X Y Z)
Y]
Specializations (Identity1))
(PUTPROPS Proj1of3 Worth 500
IsA (MathConcept MathOp Op Anything TertiaryOp)
Arity 3
Domain (Anything Anything Anything)
Range (Anything)
ElimSlots (Applics)
FastAlg [LAMBDA (X Y Z)
X]
Specializations (Identity1))
(PUTPROPS Proj2 Worth 500
IsA (MathConcept MathOp Op Anything BinaryOp)
Arity 2
Domain (Anything Anything)
Range (Anything)
ElimSlots (Applics)
FastAlg [LAMBDA (X Y)
Y]
Specializations (Identity1))
(PUTPROPS Proj1 Worth 500
IsA (MathConcept MathOp Op Anything BinaryOp)
Arity 2
Domain (Anything Anything)
Range (Anything)
ElimSlots (Applics)
FastAlg [LAMBDA (X Y)
X]
Specializations (Identity1))
(PUTPROPS MEMB Worth 500
IsA (MathConcept MathOp Op MathPred Pred Anything BinaryOp BinaryPred)
FastAlg [LAMBDA (X Y)
(MEMB X Y]
Arity 2
Domain (Anything Structure)
Range (Bit)
ElimSlots (Applics)
RecursiveAlg [LAMBDA (X S)
(COND ((NULL S)
NIL)
((EQ X (CAR S))
T)
(T (RunAlg (QUOTE MEMB)
X
(CDR S]
IsAInt (BinaryPred)
Rarity (.1 1 9))
(PUTPROPS MEMBER Worth 500
IsA (MathConcept MathOp Op MathPred Pred Anything BinaryOp BinaryPred)
FastAlg [LAMBDA (X Y)
(MEMBER X Y]
Arity 2
Domain (Anything Structure)
Range (Bit)
ElimSlots (Applics)
RecursiveAlg [LAMBDA (X S)
(COND ((NULL S)
NIL)
((EQUAL X (CAR S))
T)
(T (RunAlg (QUOTE MEMBER)
X
(CDR S]
IsAInt (BinaryPred)
Rarity (.1 1 9))
(PUTPROPS AllButLast Worth 500
IsA (MathConcept MathOp Op Anything UnaryOp)
Arity 1
Domain (OrdStruc)
Range (Anything)
ElimSlots (Applics)
FastAlg [LAMBDA (s)
(LDIFF s (LAST s])
(PUTPROPS LastEle Worth 500
IsA (MathConcept MathOp Op Anything UnaryOp)
Arity 1
Domain (OrdStruc)
Range (Anything)
ElimSlots (Applics)
FastAlg [LAMBDA (s)
(CAR (LAST s])
(PUTPROPS AllButThird Worth 500
IsA (MathConcept MathOp Op Anything UnaryOp)
Arity 1
Domain (OrdStruc)
Range (Anything)
ElimSlots (Applics)
FastAlg [LAMBDA (s)
(CONS (CAR s)
(CONS (CADR s)
(CDDDR s])
(PUTPROPS AllButSecond Worth 500
IsA (MathConcept MathOp Op Anything UnaryOp)
Arity 1
Domain (OrdStruc)
Range (Anything)
ElimSlots (Applics)
FastAlg [LAMBDA (s)
(CONS (CAR s)
(CDDR s])
(PUTPROPS AllButFirst Worth 500
IsA (MathConcept MathOp Op Anything UnaryOp)
Arity 1
Domain (OrdStruc)
Range (Anything)
ElimSlots (Applics)
FastAlg CDR)
(PUTPROPS ThirdEle Worth 500
IsA (MathConcept MathOp Op Anything UnaryOp)
Arity 1
Domain (OrdStruc)
Range (Anything)
ElimSlots (Applics)
FastAlg CADDR)
(PUTPROPS SecondEle Worth 500
IsA (MathConcept MathOp Op Anything UnaryOp)
Arity 1
Domain (OrdStruc)
Range (Anything)
ElimSlots (Applics)
FastAlg CADR
Rarity (.85 17 3))
(PUTPROPS FirstEle Worth 500
IsA (MathConcept MathOp Op Anything UnaryOp)
Arity 1
Domain (OrdStruc)
Range (Anything)
ElimSlots (Applics)
FastAlg CAR)
(PUTPROPS ReverseOPair Worth 500
IsA (MathConcept MathOp Op Anything UnaryOp OrdStrucOp ListOp)
Arity 1
Domain (OPair)
Range (OPair)
ElimSlots (Applics)
FastAlg [LAMBDA (p)
(LIST (CADR p)
(CAR p])
(PUTPROPS Pair Worth 500
IsA (MathConcept MathObj Anything Category TypeOfStructure)
Generator ((NIL)
(GetAOPair)
(old))
FastDefn [LAMBDA (s)
(EQ 2 (LENGTH s]
Generalizations (Anything Structure MultEleStruc UnOrdStruc Bag)
Specializations (NonEmptyStruc))
(PUTPROPS OPair Worth 500
IsA (MathConcept MathObj Anything Category TypeOfStructure)
Generator ((NIL)
(GetAOPair)
(old))
FastDefn [LAMBDA (s)
(EQ 2 (LENGTH s]
Generalizations (Anything Structure MultEleStruc OrdStruc List)
InDomainOf (ReverseOPair)
IsRangeOf (ReverseOPair)
Specializations (NonEmptyStruc))
(PUTPROPS ParallelJoin2 Worth 800
IsA (MathConcept MathOp Op Anything TertiaryOp)
Arity 3
Domain (TypeOfStructure TypeOfStructure BinaryOp)
Range (BinaryOp)
ElimSlots (Applics)
FastAlg [LAMBDA (S S2 f nam fargs typmem)
(* note that S is the name of a type of structure, such as
List, rather than a particular individual structure,
such as (a b c d))
(COND
([AND (MEMB (QUOTE Structure)
(Generalizations S))
(MEMB (QUOTE Structure)
(Generalizations S2))
(MEMB (QUOTE Op)
(IsA f))
(EQ 2 (LENGTH (Domain f)))
(IsAKindOf S2 (CADR (Domain f)))
(OR (EQ (CAR (Domain f))
(QUOTE Anything))
(AND (SETQ typmem (EachElementIsA S))
(IsAKindOf typmem (CAR (Domain f]
[SETQ nam (CreateUnit (PACK* (QUOTE Join)
f
(QUOTE On)
S
(QUOTE s)
(QUOTE WithA)
S2
(QUOTE AsParam]
(PUT nam (QUOTE IsA)
(IsA f))
[PUT nam (QUOTE Worth)
(AverageWorths (QUOTE ParallelReplace2)
(AverageWorths f (AverageWorths
S S2]
(PUT nam (QUOTE Arity)
2)
(PUT nam (QUOTE Domain)
(LIST S S2))
[PUT nam (QUOTE Range)
(LIST (COND ([Unitp (SETQ
mu
(PACK* S (QUOTE Of)
(CAR (Range f))
(QUOTE s]
mu)
(T (CPRIN1 21 CRLF
" It might be nice to have a unit called "
mu CRLF)
S]
[PUT nam (QUOTE UnitizedAlg)
(SUBST f (QUOTE f)
(QUOTE (LAMBDA
(s s2)
(MAPAPPEND s
(FUNCTION
(LAMBDA
(e)
(RunAlg
(QUOTE f)
e s2]
(PUT nam (QUOTE ElimSlots)
(LIST (QUOTE Applics)))
(PUT nam (QUOTE Creditors)
(LIST (QUOTE ParallelReplace2)))
(AddInv nam)
nam)
(T (QUOTE Failed]
Rarity (.3272727 36 74))
(PUTPROPS ParallelJoin Worth 800
IsA (MathConcept MathOp Op Anything BinaryOp)
Arity 2
Domain (TypeOfStructure UnaryOp)
Range (UnaryOp)
ElimSlots (Applics)
FastAlg [LAMBDA (S f nam fargs typmem)
(* note that S is the name of a type of structure, such as
List, rather than a particular individual structure, such
as (a b c d))
(COND
((AND (MEMB (QUOTE Structure)
(Generalizations S))
(MEMB (QUOTE Op)
(IsA f))
(EQ 1 (LENGTH (Domain f)))
[OR (EQ (CAR (Domain f))
(QUOTE Anything))
(AND (SETQ typmem (EachElementIsA S))
(IsAKindOf typmem (CAR (Domain f]
(IsAKindOf (CAR (Range f))
(QUOTE Structure)))
[SETQ nam (CreateUnit (PACK* (QUOTE Join)
f
(QUOTE On)
S
(QUOTE s]
(PUT nam (QUOTE IsA)
(COPY (IsA f)))
(PUT nam (QUOTE Worth)
(AverageWorths (QUOTE ParallelJoin)
(AverageWorths f S)))
(PUT nam (QUOTE Arity)
1)
(PUT nam (QUOTE Domain)
(LIST S))
[PUT nam (QUOTE Range)
(LIST (COND ([Unitp (SETQ
mu
(PACK* S (QUOTE Of)
(CAR (Range f))
(QUOTE s]
mu)
(T (CPRIN1 21 CRLF
" It might be nice to have a unit called "
mu CRLF)
S]
[PUT nam (QUOTE UnitizedAlg)
(SUBST f (QUOTE f)
(QUOTE (LAMBDA
(s)
(MAPAPPEND s
(FUNCTION
(LAMBDA
(e)
(RunAlg (QUOTE f)
e]
(PUT nam (QUOTE ElimSlots)
(LIST (QUOTE Applics)))
(PUT nam (QUOTE Creditors)
(LIST (QUOTE ParallelJoin)))
(AddInv nam)
nam)
(T (* we should check for cases where f could sub for
other than the first arg of g)
(QUOTE Failed])
(PUTPROPS Repeat2 Worth 800
IsA (MathConcept MathOp Op Anything TertiaryOp)
Arity 3
Domain (TypeOfStructure TypeOfStructure TertiaryOp)
Range (BinaryOp)
ElimSlots (Applics)
FastAlg [LAMBDA (S S2 f nam fargs typmem)
(* note that S is the name of a type of structure, such as List,
rather than a particular individual structure, such as
(a b c d))
(COND ([AND (MEMB (QUOTE Structure)
(Generalizations S))
(MEMB (QUOTE Structure)
(Generalizations S2))
(MEMB (QUOTE Op)
(IsA f))
(EQ 3 (LENGTH (Domain f)))
[OR (EQ (CADDR (Domain f))
(QUOTE Anything))
(AND (SETQ typmem (EachElementIsA S))
(IsAKindOf typmem (CADDR (Domain f]
(IsAKindOf (CAR (Range f))
(CAR (Domain f)))
(IsAKindOf S2 (CADR (Domain f]
[SETQ nam (CreateUnit (PACK* (QUOTE Repeat2)
f
(QUOTE On)
S
(QUOTE s)
(QUOTE WithA)
S2
(QUOTE AsParam]
[PUT nam (QUOTE IsA)
(CONS (QUOTE BinaryOp)
(REMOVE (QUOTE TertiaryOp)
(IsA f]
[PUT nam (QUOTE Worth)
(AverageWorths (QUOTE Repeat2)
(AverageWorths f (AverageWorths S S2]
(PUT nam (QUOTE Arity)
2)
(PUT nam (QUOTE Domain)
(LIST S S2))
(PUT nam (QUOTE Range)
(COPY (Range f)))
[PUT nam (QUOTE UnitizedAlg)
(SUBST f (QUOTE f)
(QUOTE (LAMBDA
(s s2 v)
(SETQ v (CAR s))
[MAPC (CDR s)
(FUNCTION
(LAMBDA
(e)
(SETQ v
(RunAlg (QUOTE f)
v s2 e]
v]
(PUT nam (QUOTE ElimSlots)
(LIST (QUOTE Applics)))
(PUT nam (QUOTE Creditors)
(LIST (QUOTE Repeat2)))
(AddInv nam)
nam)
(T (* we should check for cases where f could sub for other
than the first arg of g)
(QUOTE Failed]
Rarity (.2295082 14 47))
(PUTPROPS TertiaryOp Generalizations (Op Anything)
Worth 500
IsA (ReprConcept Anything Category OpCatByNArgs)
Examples (ParallelReplace2 Repeat2 ParallelJoin2 Proj1of3 Proj2of3 Proj3of3)
InDomainOf (Repeat2)
LowerArity (BinaryOp)
Specializations (TertiaryPred)
FastDefn [LAMBDA (f)
(EQ 3 (Arity f]
Rarity (.3978495 37 56))
(PUTPROPS Repeat Worth 800
IsA (MathConcept MathOp Op Anything BinaryOp)
Arity 2
Domain (TypeOfStructure BinaryOp)
Range (UnaryOp)
ElimSlots (Applics)
FastAlg [LAMBDA (S f nam fargs typmem)
(* note that S is the name of a type of structure, such as List,
rather than a particular individual structure, such as
(a b c d))
(COND ([AND (MEMB (QUOTE Structure)
(Generalizations S))
(MEMB (QUOTE Op)
(IsA f))
(EQ 2 (LENGTH (Domain f)))
[OR (EQ (CADR (Domain f))
(QUOTE Anything))
(AND (SETQ typmem (EachElementIsA S))
(IsAKindOf typmem (CADR (Domain f]
(IsAKindOf (CAR (Range f))
(CAR (Domain f]
[SETQ nam (CreateUnit (PACK* (QUOTE Repeat)
f
(QUOTE On)
S
(QUOTE s]
(PUT nam (QUOTE IsA)
(SUBST (QUOTE UnaryOp)
(QUOTE BinaryOp)
(IsA f)))
(PUT nam (QUOTE Worth)
(AverageWorths (QUOTE Repeat)
(AverageWorths f S)))
(PUT nam (QUOTE Arity)
1)
(PUT nam (QUOTE Domain)
(LIST S))
(PUT nam (QUOTE Range)
(COPY (Range f)))
[PUT nam (QUOTE UnitizedAlg)
(SUBST f (QUOTE f)
(QUOTE (LAMBDA
(s v)
(SETQ v (CAR s))
[MAPC (CDR s)
(FUNCTION
(LAMBDA (e)
(SETQ
v
(RunAlg
(QUOTE f)
v e]
v]
(PUT nam (QUOTE ElimSlots)
(LIST (QUOTE Applics)))
(PUT nam (QUOTE Creditors)
(LIST (QUOTE Repeat)))
(AddInv nam)
nam)
(T (* we should check for cases where f could sub for other
than the first arg of g)
(QUOTE Failed]
Rarity (.3555556 16 29))
(PUTPROPS BinaryOp InDomainOf (ParallelReplace2 Repeat ParallelJoin2)
Generalizations (Op Anything)
Worth 500
Examples (ParallelReplace BagDifference OSetDifference ListDifference
SetDifference StrucDifference BagUnion ListUnion
OSetUnion StrucUnion BagIntersect OSetIntersect
ListIntersect StrucIntersect SetUnion SetIntersect
OrdStrucEqual BagEqual ListEqual OSetEqual OSetDelete
OSetInsert MultEleStrucDelete1 BagDelete1 BagDelete
BagInsert ListDelete1 ListDelete ListInsert SetDelete
SetInsert StrucDelete StrucInsert AND Add AlwaysNIL2
AlwaysT2 Compose EQ EQUAL IEQP IGEQ IGREATERP ILEQ
ILESSP Multiply OR SetEqual StrucEqual Subsetp
TheFirstOf TheSecondOf Repeat ParallelJoin MEMBER MEMB
Proj1 Proj2 Implies MultEleStrucInsert)
IsA (ReprConcept Anything Category OpCatByNArgs)
IsRangeOf (ParallelReplace2 Repeat2 ParallelJoin2)
LowerArity (UnaryOp)
HigherArity (TertiaryOp)
Specializations (BinaryPred)
FastDefn [LAMBDA (f)
(EQ 2 (Arity f]
Rarity (.1827957 17 76))
(PUTPROPS ParallelReplace2 Worth 800
IsA (MathConcept MathOp Op Anything TertiaryOp)
Arity 3
Domain (TypeOfStructure TypeOfStructure BinaryOp)
Range (BinaryOp)
ElimSlots (Applics)
FastAlg [LAMBDA
(S S2 f nam fargs typmem)
(* note that S is the name of a type of structure, such as
List, rather than a particular individual structure, such
as (a b c d))
(COND ([AND (MEMB (QUOTE Structure)
(Generalizations S))
(MEMB (QUOTE Structure)
(Generalizations S2))
(MEMB (QUOTE Op)
(IsA f))
(EQ 2 (LENGTH (Domain f)))
(IsAKindOf S2 (CADR (Domain f)))
(OR (EQ (CAR (Domain f))
(QUOTE Anything))
(AND (SETQ typmem (EachElementIsA S))
(IsAKindOf typmem (CAR (Domain f]
[SETQ nam (CreateUnit (PACK* (QUOTE Perform)
f
(QUOTE On)
S
(QUOTE s)
(QUOTE WithA)
S2
(QUOTE AsParam]
(PUT nam (QUOTE IsA)
(IsA f))
[PUT nam (QUOTE Worth)
(AverageWorths (QUOTE ParallelReplace2)
(AverageWorths f (AverageWorths
S S2]
(PUT nam (QUOTE Arity)
2)
(PUT nam (QUOTE Domain)
(LIST S S2))
[PUT nam (QUOTE Range)
(LIST (COND ([Unitp (SETQ
mu
(PACK* S (QUOTE Of)
(CAR (Range f))
(QUOTE s]
mu)
(T (CPRIN1 21 CRLF
" It might be nice to have a unit called "
mu CRLF)
S]
[PUT nam (QUOTE UnitizedAlg)
(SUBST f (QUOTE f)
(QUOTE (LAMBDA
(s s2)
(MAPCAR s (FUNCTION
(LAMBDA
(e)
(RunAlg (QUOTE f)
e s2]
(PUT nam (QUOTE ElimSlots)
(LIST (QUOTE Applics)))
(PUT nam (QUOTE Creditors)
(LIST (QUOTE ParallelReplace2)))
(AddInv nam)
nam)
(T (QUOTE Failed]
Rarity (.375 3 5))
(PUTPROPS EachElementIsA Worth 600
IsA (Slot CriterialSlot ReprConcept Anything)
DataType Unit)
(PUTPROPS UnaryOp Generalizations (Op Anything)
Worth 500
Examples (Coalesce AlwaysNIL AlwaysT BestChoose BestSubset ConstantBinaryPred
ConstantUnaryPred DivisorsOf GoodChoose GoodSubset
RandomChoose RandomSubset Square Successor UndefinedPred
ReverseOPair FirstEle SecondEle ThirdEle AllButFirst
AllButSecond AllButThird LastEle AllButLast Identity1 Restrict
InvertOp NOT)
IsA (ReprConcept Anything Category OpCatByNArgs)
InDomainOf (ParallelReplace ParallelJoin)
IsRangeOf (ParallelReplace Repeat ParallelJoin)
HigherArity (BinaryOp)
Specializations (UnaryPred)
FastDefn [LAMBDA (f)
(EQ 1 (Arity f]
Rarity (.2473118 23 70))
(PUTPROPS TypeOfStructure InDomainOf (ParallelReplace ParallelReplace2 Repeat Repeat2 ParallelJoin
ParallelJoin2)
Worth 500
IsA (Category Anything ReprConcept)
Examples (Set List Bag MultEleStruc OSet NoMultEleStruc OrdStruc
UnOrdStruc OPair Pair EmptyStruc NonEmptyStruc)
Generalizations (Category))
(PUTPROPS ParallelReplace Worth 888
IsA (MathConcept MathOp Op Anything BinaryOp)
Arity 2
Domain (TypeOfStructure UnaryOp)
Range (UnaryOp)
ElimSlots (Applics)
FastAlg [LAMBDA
(S f nam fargs typmem)
(* note that S is the name of a type of structure, such as
List, rather than a particular individual structure, such as
(a b c d))
(COND ([AND (MEMB (QUOTE Structure)
(Generalizations S))
(MEMB (QUOTE Op)
(IsA f))
(EQ 1 (LENGTH (Domain f)))
(OR (EQ (CAR (Domain f))
(QUOTE Anything))
(AND (SETQ typmem (EachElementIsA S))
(IsAKindOf typmem (CAR (Domain f]
[SETQ nam (CreateUnit (PACK* (QUOTE Perform)
f
(QUOTE On)
S
(QUOTE s]
(PUT nam (QUOTE IsA)
(COPY (IsA f)))
(PUT nam (QUOTE Worth)
(AverageWorths (QUOTE ParallelReplace)
(AverageWorths f S)))
(PUT nam (QUOTE Arity)
1)
(PUT nam (QUOTE Domain)
(LIST S))
[PUT nam (QUOTE Range)
(LIST (COND ([Unitp (SETQ
mu
(PACK* S (QUOTE Of)
(CAR (Range f))
(QUOTE s]
mu)
(T (CPRIN1 21 CRLF
" It might be nice to have a unit called "
mu CRLF)
S]
[PUT nam (QUOTE UnitizedAlg)
(SUBST f (QUOTE f)
(QUOTE (LAMBDA
(s)
(MAPCAR s (FUNCTION
(LAMBDA
(e)
(RunAlg (QUOTE f)
e]
(PUT nam (QUOTE ElimSlots)
(LIST (QUOTE Applics)))
(PUT nam (QUOTE Creditors)
(LIST (QUOTE ParallelReplace)))
(AddInv nam)
nam)
(T (* we should check for cases where f could sub for
other than the first arg of g)
(QUOTE Failed]
Rarity (.2372881 14 45))
(PUTPROPS Coalesce Worth 900
IsA (MathConcept MathOp Op Anything UnaryOp)
Arity 1
Domain (Op)
Range (Op)
ElimSlots (Applics)
FastAlg [LAMBDA (f nam coargs newargs newdom fargs)
(COND ((SETQ coargs (RandomPair (Domain f)
(QUOTE IsAKindOf)))
(SETQ nam (CreateUnit (PACK* (QUOTE Coa)
f)))
[PUT nam (QUOTE IsA)
(SetDiff (IsA f)
(Examples (QUOTE OpCatByNArgs]
(* We really should check that each such unit still
claims Coa-f as an example -- eg, suppose f was a
BinaryPred)
(PUT nam (QUOTE Worth)
(AverageWorths (QUOTE Coalesce)
f))
(PUT nam (QUOTE Arity)
(SUB1 (Arity f)))
(SETQ fargs
(MAP2CAR (Domain f)
(QUOTE (u v w x y z z2 z3 z4 z5))
(QUOTE TheSecondOf)))
(SETQ newargs (COPY fargs))
[RPLACA (NTH newargs (CADR coargs))
(CAR (NTH newargs (CAR coargs]
(SETQ newdom (COPY (Domain f)))
[RPLACA (NTH newdom (CADR coargs))
(CAR (NTH newdom (CAR coargs]
[COND ((ILEQ (CADR coargs)
1)
(SETQ newdom (CDR newdom)))
(T (RPLACD (NTH newdom (SUB1 (CADR coargs)))
(CDR (NTH newdom (CADR coargs]
[COND ((ILEQ (CADR coargs)
1)
(SETQ fargs (CDR fargs)))
(T (RPLACD (NTH fargs (SUB1 (CADR coargs)))
(CDR (NTH fargs (CADR coargs]
(PUT nam (QUOTE Domain)
newdom)
(PUT nam (QUOTE Range)
(COPY (Range f)))
[PUT nam (QUOTE UnitizedAlg)
(LIST (QUOTE LAMBDA)
fargs
(CONS (QUOTE RunAlg)
(CONS (KWOTE f)
newargs]
(PUT nam (QUOTE ElimSlots)
(LIST (QUOTE Applics)))
(PUT nam (QUOTE Creditors)
(LIST (QUOTE Coalesce)))
[PUT nam (QUOTE IsA)
(APPEND (IsA nam)
(SUBSET (Examples (QUOTE OpCatByNArgs))
(FUNCTION (LAMBDA (PC)
(RunDefn PC nam]
(AddInv nam)
nam)
(T (* we should check for cases where 2 domain components
of f have a common nontrivial specialization)
(QUOTE Failed]
Rarity (.3928571 22 34))
(PUTPROPS BagDifference Worth 500
IsA (MathConcept MathOp Op Anything StrucOp BagOp BinaryOp)
Arity 2
Domain (Bag Bag)
Range (Bag)
ElimSlots (Applics)
RecursiveAlg [LAMBDA (s1 s2)
(COND ((NULL s1)
NIL)
((MEMBER (CAR s1)
s2)
(RunAlg (QUOTE BagDifference)
(CDR s1)
(RunAlg (QUOTE BagDelete1)
(CAR s1)
s2)))
(T (CONS (CAR s1)
(RunAlg (QUOTE BagDifference)
(CDR s1)
(RunAlg (QUOTE BagDelete1)
(CAR s1)
s2]
Generalizations (StrucDifference))
(PUTPROPS OSetDifference Worth 500
IsA (MathConcept MathOp Op Anything StrucOp OSetOp BinaryOp)
Arity 2
Domain (OSet OSet)
Range (OSet)
ElimSlots (Applics)
FastAlg SetDifference
RecursiveAlg [LAMBDA (s1 s2)
(COND ((NULL s1)
NIL)
((MEMBER (CAR s1)
s2)
(RunAlg (QUOTE OSetDifference)
(CDR s1)
s2))
(T (CONS (CAR s1)
(RunAlg (QUOTE OSetDifference)
(CDR s1)
s2]
Generalizations (StrucDifference))
(PUTPROPS ListDifference Worth 500
IsA (MathConcept MathOp Op Anything StrucOp ListOp BinaryOp)
Arity 2
Domain (List List)
Range (List)
ElimSlots (Applics)
RecursiveAlg [LAMBDA (s1 s2)
(COND ((NULL s1)
NIL)
((MEMBER (CAR s1)
s2)
(RunAlg (QUOTE ListDifference)
(CDR s1)
(RunAlg (QUOTE ListDelete1)
(CAR s1)
s2)))
(T (CONS (CAR s1)
(RunAlg (QUOTE ListDifference)
(CDR s1)
(RunAlg (QUOTE ListDelete1)
(CAR s1)
s2]
Generalizations (StrucDifference))
(PUTPROPS SetDifference Worth 500
IsA (MathConcept MathOp Op Anything StrucOp SetOp BinaryOp)
Arity 2
Domain (Set Set)
Range (Set)
ElimSlots (Applics)
FastAlg SetDifference
RecursiveAlg [LAMBDA (s1 s2)
(COND ((NULL s1)
NIL)
((MEMBER (CAR s1)
s2)
(RunAlg (QUOTE SetDifference)
(CDR s1)
s2))
(T (CONS (CAR s1)
(RunAlg (QUOTE SetDifference)
(CDR s1)
s2]
Generalizations (StrucDifference))
(PUTPROPS StrucDifference Worth 500
IsA (MathConcept MathOp Op Anything StrucOp BinaryOp)
Arity 2
Domain (Structure Structure)
Range (Structure)
ElimSlots (Applics)
Specializations (SetDifference ListDifference OSetDifference
BagDifference))
(PUTPROPS BagUnion Worth 500
IsA (MathConcept MathOp Op Anything StrucOp BagOp BinaryOp)
Arity 2
Domain (Bag Bag)
Range (Bag)
ElimSlots (Applics)
RecursiveAlg [LAMBDA (s1 s2)
(COND ((NULL s1)
s2)
(T (RunAlg (QUOTE BagInsert)
(CAR s1)
(RunAlg (QUOTE BagUnion)
(CDR s1)
(RunAlg (QUOTE BagDelete1)
(CAR s1)
s2]
Generalizations (StrucUnion))
(PUTPROPS ListUnion Worth 500
IsA (MathConcept MathOp Op Anything StrucOp ListOp BinaryOp)
Arity 2
Domain (List List)
Range (List)
ElimSlots (Applics)
FastAlg APPEND
RecursiveAlg [LAMBDA (s1 s2)
(COND ((NULL s1)
s2)
(T (CONS (CAR s1)
(RunAlg (QUOTE ListUnion)
(CDR s1)
s2]
Generalizations (StrucUnion))
(PUTPROPS OSetUnion Worth 500
IsA (MathConcept MathOp Op Anything StrucOp OSetOp BinaryOp)
Arity 2
Domain (OSet OSet)
Range (OSet)
ElimSlots (Applics)
FastAlg SetUnion
RecursiveAlg [LAMBDA (s1 s2)
(COND ((NULL s1)
s2)
((MEMBER (CAR s1)
s2)
(RunAlg (QUOTE OSetUnion)
(CDR s1)
s2))
(T (CONS (CAR s1)
(RunAlg (QUOTE OSetUnion)
(CDR s1)
s2]
Generalizations (StrucUnion))
(PUTPROPS StrucUnion Worth 500
IsA (MathConcept MathOp Op Anything StrucOp BinaryOp)
Arity 2
Domain (Structure Structure)
Range (Structure)
ElimSlots (Applics)
Specializations (SetUnion OSetUnion ListUnion BagUnion))
(PUTPROPS BagIntersect Worth 500
IsA (MathConcept MathOp Op Anything StrucOp BagOp BinaryOp)
Arity 2
Domain (Bag Bag)
Range (Bag)
ElimSlots (Applics)
IterativeAlg [LAMBDA (s1 s2)
[for x in (APPEND s1)
do
(COND ((MEMBER x s2)
(SETQ s2 (RunAlg (QUOTE BagDelete1)
x s2)))
(T (SETQ s1 (RunAlg (QUOTE BagDelete1)
x s1]
s1]
Generalizations (StrucIntersect))
(PUTPROPS OSetIntersect Worth 500
IsA (MathConcept MathOp Op Anything StrucOp OSetOp BinaryOp)
Arity 2
Domain (OSet OSet)
Range (OSet)
ElimSlots (Applics)
FastAlg OSetIntersect
RecursiveAlg [LAMBDA (s1 s2)
(COND ((NULL s1)
NIL)
((MEMBER (CAR s1)
s2)
(CONS (CAR s1)
(RunAlg (QUOTE OSetIntersect)
(CDR s1)
s2)))
(T (RunAlg (QUOTE OSetIntersect)
(CDR s1)
s2]
Generalizations (StrucIntersect))
(PUTPROPS ListIntersect Worth 500
IsA (MathConcept MathOp Op Anything StrucOp ListOp BinaryOp)
Arity 2
Domain (List List)
Range (List)
ElimSlots (Applics)
RecursiveAlg [LAMBDA (s1 s2)
(COND ((NULL s1)
NIL)
[(MEMBER (CAR s1)
s2)
(CONS (CAR s1)
(RunAlg (QUOTE ListIntersect)
(CDR s1)
(RunAlg (QUOTE ListDelete1)
(CAR s1)
s2]
(T (RunAlg (QUOTE ListIntersect)
(CDR s1)
s2]
Generalizations (StrucIntersect))
(PUTPROPS StrucIntersect Worth 500
IsA (MathConcept MathOp Op Anything StrucOp BinaryOp)
Arity 2
Domain (Structure Structure)
Range (Structure)
ElimSlots (Applics)
Specializations (SetIntersect ListIntersect OSetIntersect BagIntersect))
(PUTPROPS SetUnion Worth 500
IsA (MathConcept MathOp Op Anything StrucOp SetOp BinaryOp)
Arity 2
Domain (Set Set)
Range (Set)
ElimSlots (Applics)
FastAlg SetUnion
RecursiveAlg [LAMBDA (s1 s2)
(COND ((NULL s1)
s2)
((MEMBER (CAR s1)
s2)
(RunAlg (QUOTE SetUnion)
(CDR s1)
s2))
(T (CONS (CAR s1)
(RunAlg (QUOTE SetUnion)
(CDR s1)
s2]
Generalizations (StrucUnion))
(PUTPROPS SetIntersect Worth 500
IsA (MathConcept MathOp Op Anything StrucOp SetOp BinaryOp)
Arity 2
Domain (Set Set)
Range (Set)
ElimSlots (Applics)
FastAlg SetIntersect
RecursiveAlg [LAMBDA (s1 s2)
(COND ((NULL s1)
NIL)
((MEMBER (CAR s1)
s2)
(CONS (CAR s1)
(RunAlg (QUOTE SetIntersect)
(CDR s1)
s2)))
(T (RunAlg (QUOTE SetIntersect)
(CDR s1)
s2]
Generalizations (StrucIntersect))
(PUTPROPS OrdStrucOp Generalizations (MathConcept Op MathOp Anything StrucOp)
Worth 500
IsA (MathConcept MathObj Anything Category)
Abbrev (Operations on structures which are ordered)
Specializations (ListOp OSetOp)
Examples (OrdStrucEqual ReverseOPair))
(PUTPROPS OrdStrucEqual Worth 500
IsA (MathConcept MathOp Op Anything StrucOp OrdStrucOp BinaryOp)
Arity 2
Domain (OrdStruc OrdStruc)
Range (Anything)
ElimSlots (Applics)
Specializations (ListEqual OSetEqual)
FastAlg EQUAL)
(PUTPROPS BagEqual Worth 500
IsA (MathConcept MathOp Op MathPred Pred Anything StrucOp BagOp BinaryOp
BinaryPred)
Arity 2
Domain (Bag Bag)
Range (Bit)
ElimSlots (Applics)
Generalizations (EQUAL StrucEqual)
RecursiveAlg [LAMBDA (s1 s2)
(COND ((AND (NULL s1)
(NULL s2))
T)
(T (AND (LISTP s1)
(LISTP s2)
(MEMBER (CAR s1)
s2)
(RunAlg (QUOTE BagEqual)
(CDR s1)
(RunAlg (QUOTE BagDelete1)
(CAR s1)
s2]
Specializations (ListEqual)
IsAInt (BinaryPred)
Rarity (.1 1 9))
(PUTPROPS ListEqual Worth 500
IsA (MathConcept MathOp Op MathPred Pred Anything StrucOp ListOp BinaryOp
BinaryPred)
Arity 2
Domain (List List)
Range (Bit)
ElimSlots (Applics)
Generalizations (EQUAL StrucEqual BagEqual OrdStrucEqual)
RecursiveAlg [LAMBDA (s1 s2)
(COND ((AND (NULL s1)
(NULL s2))
T)
(T (AND (LISTP s1)
(LISTP s2)
(EQUAL (CAR s1)
(CAR s2))
(RunAlg (QUOTE ListEqual)
(CDR s1)
(CDR s2]
FastAlg EQUAL
IsAInt (BinaryPred)
Rarity (.1 1 9))
(PUTPROPS OSetEqual Worth 500
IsA (MathConcept MathOp Op MathPred Pred Anything StrucOp OSetOp BinaryOp
BinaryPred)
Arity 2
Domain (OSet OSet)
Range (Bit)
ElimSlots (Applics)
Generalizations (EQUAL StrucEqual Subsetp SetEqual OrdStrucEqual)
RecursiveAlg [LAMBDA (s1 s2)
(COND ((AND (NULL s1)
(NULL s2))
T)
(T (AND (LISTP s1)
(LISTP s2)
(EQUAL (CAR s1)
(CAR s2))
(RunAlg (QUOTE OSetEqual)
(CDR s1)
(CDR s2]
FastAlg EQUAL
IsAInt (BinaryPred)
Rarity (.1 1 9))
(PUTPROPS SufDefn Worth 600
IsA (Slot CriterialSlot ReprConcept Anything)
DataType LispPred
Generalizations (Defn)
SuperSlots (Defn))
(PUTPROPS NecDefn Worth 600
IsA (Slot CriterialSlot ReprConcept Anything)
DataType LispPred
Generalizations (Defn)
SuperSlots (Defn))
(PUTPROPS UnOrdStruc Worth 500
IsA (MathConcept MathObj Anything Category TypeOfStructure)
Specializations (Bag Set Pair EmptyStruc NonEmptyStruc)
Generalizations (Structure Anything))
(PUTPROPS OrdStruc Worth 500
IsA (MathConcept MathObj Anything Category TypeOfStructure)
Specializations (List OSet OPair EmptyStruc NonEmptyStruc)
Generalizations (Structure Anything)
InDomainOf (OrdStrucEqual AllButFirst FirstEle SecondEle ThirdEle AllButSecond
AllButThird LastEle AllButLast))
(PUTPROPS NoMultEleStruc Worth 500
IsA (MathConcept MathObj Anything Category TypeOfStructure)
Specializations (Set OSet EmptyStruc NonEmptyStruc)
Generalizations (Structure Anything)
NecDefn NoRepeatsIn)
(PUTPROPS OSetDelete Worth 500
IsA (MathConcept MathOp Op Anything StrucOp OSetOp BinaryOp)
Arity 2
Domain (Anything OSet)
Range (OSet)
ElimSlots (Applics)
RecursiveAlg [LAMBDA (x s)
(COND ((NULL s)
NIL)
((EQUAL x (CAR s))
(CDR s))
(T (CONS (CAR s)
(RunAlg (QUOTE OSetDelete)
x
(CDR s]
FastAlg REMOVE
Generalizations (StrucDelete))
(PUTPROPS OSetOp Generalizations (MathConcept Op MathOp Anything StrucOp OrdStrucOp)
Worth 500
IsA (MathConcept MathObj Anything Category)
Abbrev (OSet Operations)
Examples (OSetInsert OSetDelete OSetEqual OSetIntersect OSetUnion OSetDifference))
(PUTPROPS OSetInsert Worth 500
IsA (MathConcept MathOp Op Anything StrucOp OSetOp BinaryOp)
Arity 2
Domain (Anything OSet)
Range (OSet)
ElimSlots (Applics)
RecursiveAlg [LAMBDA (x s)
(COND ((NULL s)
(CONS x s))
((EQUAL x (CAR s))
s)
(T (CONS (CAR s)
(RunAlg (QUOTE OSetInsert)
x
(CDR s]
Generalizations (StrucInsert)
FastAlg [LAMBDA (x s)
(COND ((MEMBER x s)
s)
(T (CONS x s])
(PUTPROPS OSet Worth 500
IsA (MathConcept MathObj Anything Category TypeOfStructure)
Generator ((NIL)
(GetASet)
(old))
FastDefn [LAMBDA (s)
(OR (EQ s NIL)
(NoRepeatsIn s]
RecursiveDefn [LAMBDA (s)
(COND ((NLISTP s)
(EQ s NIL))
(T (AND (NOT (MEMBER (CAR s)
(CDR s)))
(RunDefn (QUOTE OSet)
(CDR s]
Generalizations (Anything Structure Bag List Set NoMultEleStruc OrdStruc)
InDomainOf (OSetInsert OSetDelete OSetEqual OSetIntersect OSetUnion OSetDifference)
IsRangeOf (OSetInsert OSetDelete OSetIntersect OSetUnion OSetDifference)
Specializations (EmptyStruc NonEmptyStruc)
Rarity (0 2 2)
ElimSlots (Examples))
(PUTPROPS MultEleStrucDelete1 Worth 500
IsA (MathConcept MathOp Op Anything StrucOp MultEleStrucOp BinaryOp)
Arity 2
Domain (Anything MultEleStruc)
Range (MultEleStruc)
ElimSlots (Applics)
Specializations (ListDelete1 BagDelete1)
RecursiveAlg [LAMBDA (x s)
(COND ((NULL s)
NIL)
((EQUAL x (CAR s))
(CDR s))
(T (CONS (CAR s)
(RunAlg (QUOTE
MultEleStrucDelete1)
x
(CDR s])
(PUTPROPS MultEleStrucOp Generalizations (MathConcept Op MathOp Anything StrucOp)
Worth 500
IsA (MathConcept MathObj Anything Category)
Abbrev (Operations on structures which have multiple elements)
Specializations (ListOp BagOp)
Examples (MultEleStrucDelete1 MultEleStrucInsert))
(PUTPROPS MultEleStruc Worth 500
IsA (MathConcept MathObj Anything Category TypeOfStructure)
Specializations (List Bag OPair Pair EmptyStruc NonEmptyStruc)
Generalizations (Structure Anything)
InDomainOf (MultEleStrucDelete1 MultEleStrucInsert)
IsRangeOf (MultEleStrucDelete1 MultEleStrucInsert)
SufDefn RepeatsIn)
(PUTPROPS BagDelete1 Worth 500
IsA (MathConcept MathOp Op Anything StrucOp BagOp BinaryOp)
Arity 2
Domain (Anything Bag)
Range (Bag)
ElimSlots (Applics)
RecursiveAlg [LAMBDA (x s)
(COND ((NULL s)
NIL)
((EQUAL x (CAR s))
(CDR s))
(T (CONS (CAR s)
(RunAlg (QUOTE BagDelete1)
x
(CDR s]
Generalizations (MultEleStrucDelete1))
(PUTPROPS BagDelete Worth 500
IsA (MathConcept MathOp Op Anything StrucOp BagOp BinaryOp)
Arity 2
Domain (Anything Bag)
Range (Bag)
ElimSlots (Applics)
RecursiveAlg [LAMBDA (x s)
(COND ((NULL s)
NIL)
((EQUAL x (CAR s))
(RunAlg (QUOTE BagDelete)
x
(CDR s)))
(T (CONS (CAR s)
(RunAlg (QUOTE BagDelete)
x
(CDR s]
FastAlg REMOVE
Generalizations (StrucDelete))
(PUTPROPS BagOp Generalizations (MathConcept Op MathOp Anything StrucOp MultEleStrucOp)
Worth 500
IsA (MathConcept MathObj Anything Category)
Abbrev (Bag Operations)
Examples (BagInsert BagDelete BagDelete1 BagEqual BagIntersect BagUnion
BagDifference))
(PUTPROPS BagInsert Worth 500
IsA (MathConcept MathOp Op Anything StrucOp BagOp BinaryOp)
Arity 2
Domain (Anything Bag)
Range (Bag)
ElimSlots (Applics)
FastAlg CONS
Generalizations (StrucInsert MultEleStrucInsert))
(PUTPROPS Bag Worth 500
IsA (MathConcept MathObj Anything Category TypeOfStructure)
Generator ((NIL)
(GetAList)
(old))
FastDefn [LAMBDA (s)
(OR (EQ s NIL)
(LISTP s]
RecursiveDefn [LAMBDA (s)
(COND ((NLISTP s)
(EQ s NIL))
(T (RunDefn (QUOTE Bag)
(CDR s]
Generalizations (Anything Structure MultEleStruc UnOrdStruc)
Specializations (Set OSet Pair EmptyStruc NonEmptyStruc)
InDomainOf (BagInsert BagDelete BagDelete1 BagEqual BagIntersect BagUnion
BagDifference)
IsRangeOf (BagInsert BagDelete BagDelete1 BagIntersect BagUnion BagDifference)
Rarity (0 2 2)
ElimSlots (Examples))
(PUTPROPS ListDelete1 Worth 500
IsA (MathConcept MathOp Op Anything StrucOp ListOp BinaryOp)
Arity 2
Domain (Anything List)
Range (List)
ElimSlots (Applics)
RecursiveAlg [LAMBDA (x s)
(COND ((NULL s)
NIL)
((EQUAL x (CAR s))
(CDR s))
(T (CONS (CAR s)
(RunAlg (QUOTE ListDelete1)
x
(CDR s]
Generalizations (MultEleStrucDelete1))
(PUTPROPS ListDelete Worth 500
IsA (MathConcept MathOp Op Anything StrucOp ListOp BinaryOp)
Arity 2
Domain (Anything List)
Range (List)
ElimSlots (Applics)
FastAlg REMOVE
RecursiveAlg [LAMBDA (x s)
(COND ((NULL s)
NIL)
((EQUAL x (CAR s))
(RunAlg (QUOTE ListDelete)
x
(CDR s)))
(T (CONS (CAR s)
(RunAlg (QUOTE ListDelete)
x
(CDR s]
Generalizations (StrucDelete))
(PUTPROPS List Worth 500
IsA (MathConcept MathObj Anything Category TypeOfStructure)
Generator ((NIL)
(GetAList)
(old))
FastDefn [LAMBDA (s)
(OR (EQ s NIL)
(LISTP s]
RecursiveDefn [LAMBDA (s)
(COND ((NLISTP s)
(EQ s NIL))
(T (RunDefn (QUOTE List)
(CDR s]
Generalizations (Anything Structure MultEleStruc OrdStruc)
IsRangeOf (ListInsert ListDelete ListDelete1 ListIntersect ListUnion ListDifference)
InDomainOf (ListInsert ListDelete ListDelete1 ListEqual ListIntersect ListUnion
ListDifference)
Specializations (Set OSet OPair EmptyStruc NonEmptyStruc)
Rarity (0 2 2)
ElimSlots (Examples))
(PUTPROPS ListInsert Worth 500
IsA (MathConcept MathOp Op Anything StrucOp ListOp BinaryOp)
Arity 2
Domain (Anything List)
Range (List)
ElimSlots (Applics)
FastAlg CONS
Generalizations (StrucInsert MultEleStrucInsert))
(PUTPROPS ListOp Generalizations (MathConcept Op MathOp Anything StrucOp MultEleStrucOp OrdStrucOp)
Worth 500
IsA (MathConcept MathObj Anything Category)
Abbrev (List Operations)
Examples (ListInsert ListDelete ListDelete1 ListEqual ListIntersect ListUnion
ListDifference ReverseOPair))
(PUTPROPS SetDelete Worth 500
IsA (MathConcept MathOp Op Anything StrucOp SetOp BinaryOp)
Arity 2
Domain (Anything Set)
Range (Set)
ElimSlots (Applics)
RecursiveAlg [LAMBDA (x s)
(COND ((NULL s)
NIL)
((EQUAL x (CAR s))
(CDR s))
(T (CONS (CAR s)
(RunAlg (QUOTE SetDelete)
x
(CDR s]
FastAlg REMOVE
Generalizations (StrucDelete))
(PUTPROPS SetInsert Worth 500
IsA (MathConcept MathOp Op Anything StrucOp SetOp BinaryOp)
Arity 2
Domain (Anything Set)
Range (Set)
ElimSlots (Applics)
FastAlg [LAMBDA (x s)
(COND ((MEMBER x s)
s)
(T (CONS x s]
RecursiveAlg [LAMBDA (x s)
(COND ((NULL s)
(CONS x s))
((EQUAL x (CAR s))
s)
(T (CONS (CAR s)
(RunAlg (QUOTE SetInsert)
x
(CDR s]
Generalizations (StrucInsert))
(PUTPROPS StrucDelete Worth 500
IsA (MathConcept MathOp Op Anything StrucOp BinaryOp)
Arity 2
Domain (Anything Structure)
Range (Structure)
ElimSlots (Applics)
Specializations (ListDelete BagDelete SetDelete OSetDelete))
(PUTPROPS StrucOp Generalizations (MathConcept Op MathOp Anything)
Worth 500
IsA (MathConcept MathObj Anything Category)
Abbrev (Operations on structures)
Examples (StrucInsert StrucDelete RandomChoose RandomSubset GoodChoose BestChoose
BestSubset GoodSubset SetInsert SetDelete ListInsert
ListDelete ListDelete1 BagInsert BagDelete BagDelete1
MultEleStrucDelete1 OSetInsert OSetDelete OSetEqual
SetEqual BagEqual ListEqual OrdStrucEqual SetIntersect
SetUnion StrucIntersect ListIntersect OSetIntersect
BagIntersect StrucUnion OSetUnion ListUnion BagUnion
StrucDifference SetDifference ListDifference OSetDifference
BagDifference MultEleStrucInsert)
Specializations (SetOp ListOp BagOp MultEleStrucOp OSetOp OrdStrucOp LogicOp))
(PUTPROPS StrucInsert Worth 500
IsA (MathConcept MathOp Op Anything StrucOp BinaryOp)
Arity 2
Domain (Anything Structure)
Range (Structure)
ElimSlots (Applics)
Specializations (ListInsert BagInsert SetInsert OSetInsert))
(PUTPROPS AND Worth 569
IsA (Op Pred MathOp MathPred Anything BinaryOp LogicOp BinaryPred)
FastAlg [LAMBDA (X Y)
(AND X Y]
Arity 2
Domain (Anything Anything)
Range (Anything)
ElimSlots (Applics)
Generalizations (TheSecondOf TheFirstOf OR)
Rarity (1.0 2 0))
(PUTPROPS Abbrev Worth 307
IsA (Slot NonCriterialSlot ReprConcept Anything)
DataType Text)
(PUTPROPS Add Worth 500
IsA (MathConcept MathOp Op NumOp Anything BinaryOp)
FastAlg [LAMBDA (X Y)
(PLUS X Y]
RecursiveAlg [LAMBDA (X Y)
(COND ((EQ X 0)
Y)
(T (RunAlg (QUOTE Successor)
(RunAlg (QUOTE Add)
(SUB1 X)
Y]
UnitizedAlg [LAMBDA (X Y)
(COND ((EQ X 0)
Y)
(T (RunAlg (QUOTE Successor)
(RunAlg (QUOTE Add)
(SUB1 X)
Y]
IterativeAlg [LAMBDA (X Y)
(for i from 1 to X do (SETQ Y (ADD1 Y)))
Y]
Arity 2
Domain (NNumber NNumber)
Range (NNumber)
ElimSlots (Applics))
(PUTPROPS Alg Worth 600
IsA (Slot CriterialSlot ReprConcept Anything)
DataType LispFn
SubSlots (FastAlg IterativeAlg RecursiveAlg UnitizedAlg))
(PUTPROPS AlwaysNIL Worth 500
IsA (Op Pred Anything ConstantPred UnaryOp MathOp UnaryPred)
Arity 1
Domain (Anything)
Range (Bit)
ElimSlots (Applics)
Generalizations (ConstantUnaryPred)
FastAlg [LAMBDA (x)
NIL])
(PUTPROPS AlwaysNIL2 Worth 500
IsA (Op Pred Anything ConstantPred BinaryOp MathOp BinaryPred)
Arity 2
Domain (Anything Anything)
Range (Bit)
ElimSlots (Applics)
Generalizations (ConstantBinaryPred)
FastAlg [LAMBDA (x y)
NIL])
(PUTPROPS AlwaysT Worth 500
IsA (Op Pred Anything ConstantPred UnaryOp MathOp UnaryPred)
Arity 1
Domain (Anything)
Range (Bit)
ElimSlots (Applics)
Generalizations (ConstantUnaryPred)
FastAlg [LAMBDA (x)
T])
(PUTPROPS AlwaysT2 Worth 500
IsA (Op Pred Anything ConstantPred BinaryOp MathOp BinaryPred)
Arity 2
Domain (Anything Anything)
Range (Bit)
ElimSlots (Applics)
Generalizations (ConstantBinaryPred)
FastAlg [LAMBDA (x y)
T])
(PUTPROPS Anything Worth 550
Specializations (Set Heuristic Slot NNumber Unit PrimeNum Conjecture EvenNum
Task OddNum PerfNum PerfSquare SetOfNumbers CriterialSlot
Bit NonCriterialSlot HindSightRule UnaryUnitOp MathConcept
ReprConcept MathOp MathObj SetOp UnitOp NumOp MathPred Op
Pred RecordSlot Structure ConstantPred StrucOp ListOp List
Bag BagOp MultEleStrucOp MultEleStruc OSet OSetOp
NoMultEleStruc OrdStruc UnOrdStruc OrdStrucOp UnaryOp
BinaryOp TertiaryOp OPair Pair InvertedOp SetOfOPairs
Relation LogicOp Atom TruthValue StructureOfStructures
SetOfSets EmptyStruc NonEmptyStruc UnaryPred BinaryPred
TertiaryPred)
IsA (ReprConcept Anything Category)
IsRangeOf (RandomChoose GoodChoose BestChoose AND OR TheSecondOf TheFirstOf
FirstEle SecondEle ThirdEle AllButFirst AllButSecond
AllButThird LastEle AllButLast Proj1 Proj2 Proj1of3
Proj2of3 Proj3of3 Identity1 Implies OrdStrucEqual)
InDomainOf (EQUAL EQ AND OR TheSecondOf TheFirstOf AlwaysT AlwaysNIL
ConstantBinaryPred AlwaysT2 AlwaysNIL2 ConstantUnaryPred
UndefinedPred StrucInsert StrucDelete SetInsert SetDelete
ListInsert ListDelete ListDelete1 BagInsert BagDelete
BagDelete1 MultEleStrucDelete1 OSetInsert OSetDelete MEMBER
MEMB Proj1 Proj2 Proj1of3 Proj2of3 Proj3of3 Identity1 NOT
Implies MultEleStrucInsert)
FastDefn [LAMBDA (X)
T]
Examples (AND OR TheFirstOf TheSecondOf Square DivisorsOf Multiply Add Successor
RandomChoose RandomSubset GoodChoose BestChoose BestSubset
GoodSubset EQUAL IEQP EQ ILEQ IGEQ ILESSP IGREATERP los1 los2 los3
los4 los5 los6 los7 win1 T NIL ProtoConjec 1 3 5 7 9 11 13 15 17
19 21 23 25 27 29 31 33 35 37 39 41 43 45 47 49 51 53 55 57 59 61
63 65 67 69 71 73 75 77 79 81 83 85 6 28 IfAboutToWorkOnTask
Applics IfFinishedWorkingOnTask IsA IfTrulyRelevant SubSlots
IfParts IfPotentiallyRelevant Examples DataType English Worth
Inverse Creditors Generalizations Specializations ThenAddToAgenda
ThenCompute ThenConjecture Abbrev ThenDefineNewConcepts
ThenModifySlots ThenPrintToUser ThenParts SuperSlots IfTaskParts
Format DontCopy DoubleCheck Generator IfWorkingOnTask IsRangeOf
ToDelete1 Alg FastDefn RecursiveDefn UnitizedDefn FastAlg
IterativeAlg RecursiveAlg UnitizedAlg IterativeDefn ToDelete
ApplicGenerator Arity NonExamples CompiledDefn ElimSlots
InDomainOf Domain Range IndirectApplics DirectApplics Defn
SibSlots Transpose ThenDeleteOldConcepts Subsumes SubsumedBy
OverallRecord ThenPrintToUserFailedRecord
ThenAddToAgendaFailedRecord ThenDeleteOldConceptsFailedRecord
ThenDefineNewConceptsFailedRecord ThenConjectureFailedRecord
ThenModifySlotsFailedRecord ThenComputeFailedRecord
ThenPrintToUserRecord ThenAddToAgendaRecord
ThenDeleteOldConceptsRecord ThenDefineNewConceptsRecord
ThenConjectureRecord ThenModifySlotsRecord ThenComputeRecord
RecordFor FailedRecordFor Record FailedRecord H1 H5 H6 H3 H4 H7 H8
H9 H10 H11 H2 H12 HAvoid HAvoid2 HAvoid3 H13 H14 H15 H16 H17 H18
H19 HAvoid2AND HAvoid3First HAvoidIfWorking H5Criterial H5Good
H19Criterial Set Heuristic Anything MathConcept Slot MathObj
NNumber Unit PrimeNum Conjecture ReprConcept EvenNum Task MathOp
OddNum PerfNum PerfSquare Op SetOfNumbers SetOp UnitOp NumOp
CriterialSlot Pred MathPred Bit NonCriterialSlot HindSightRule
UnaryUnitOp RecordSlot H20 Conjectures H21 ConjectureAbout
Structure Category StrucEqual SetEqual Subsetp ConstantPred
AlwaysT AlwaysNIL ConstantBinaryPred AlwaysT2 AlwaysNIL2
ConstantUnaryPred Compose UndefinedPred StrucInsert StrucOp
StrucDelete SetInsert SetDelete ListOp List ListInsert ListDelete
ListDelete1 Bag BagOp BagInsert BagDelete BagDelete1 MultEleStruc
MultEleStrucOp MultEleStrucDelete1 OSet OSetInsert OSetOp
OSetDelete NoMultEleStruc OrdStruc UnOrdStruc NecDefn SufDefn
OSetEqual BagEqual ListEqual OrdStrucOp OrdStrucEqual SetIntersect
SetUnion StrucIntersect ListIntersect OSetIntersect BagIntersect
StrucUnion OSetUnion ListUnion BagUnion StrucDifference
SetDifference ListDifference OSetDifference BagDifference Coalesce
TypeOfStructure UnaryOp ParallelReplace EachElementIsA BinaryOp
ParallelReplace2 Repeat TertiaryOp Repeat2 ParallelJoin
ParallelJoin2 OPair Pair ReverseOPair FirstEle SecondEle ThirdEle
AllButFirst AllButSecond AllButThird LastEle AllButLast MEMBER
MEMB Proj1 Proj2 Proj1of3 Proj2of3 Proj3of3 Identity1 Restrict
InvertedOp InvertOp SetOfOPairs Relation LogicOp NOT Implies Atom
TruthValue StructureOfStructures SetOfSets EmptyStruc
NonEmptyStruc Undefined LowerArity HigherArity UnaryPred
BinaryPred TertiaryPred PredCatByNArgs OpCatByNArgs Extensions
Restrictions Interestingness H22 MoreInteresting LessInteresting
IntExamples H23 H24 WhyInt Rarity IsAInt H25 H26 H27 H28 H29
MultEleStrucInsert IntApplics English-1 RestricRandomSubset-3)
Rarity (1 12 0))
(PUTPROPS ApplicGenerator Worth 600
IsA (Slot CriterialSlot ReprConcept Anything)
DataType LispFn
Format (ApplicGenInit ApplicGenBuild ApplicGenArgs))
(PUTPROPS Applics Worth 338
IsA (Slot NonCriterialSlot ReprConcept Anything)
Format ((situation resultant-units directness)
(situation resultant-units directness)
etc.)
DataType IOPair
SubSlots (DirectApplics IndirectApplics IntApplics)
DoubleCheck T
DontCopy T
MoreInteresting (IntApplics))
(PUTPROPS Arity Worth 300
IsA (Slot NonCriterialSlot ReprConcept Anything)
DataType Number)
(PUTPROPS BestChoose Worth 500
IsA (MathConcept MathOp Op SetOp Anything StrucOp UnaryOp)
FastAlg BestChoose
Domain (Set)
Range (Anything)
Generalizations (RandomChoose GoodChoose)
ElimSlots (Applics)
Arity 1)
(PUTPROPS BestSubset Worth 500
IsA (MathConcept MathOp Op SetOp Anything StrucOp UnaryOp)
FastAlg BestSubset
Domain (Set)
Range (Set)
Generalizations (RandomSubset GoodSubset)
ElimSlots (Applics)
Arity 1
Rarity (.95 19 1))
(PUTPROPS Bit IsRangeOf (EQUAL IEQP EQ ILEQ IGEQ ILESSP IGREATERP StrucEqual SetEqual Subsetp
AlwaysT AlwaysNIL ConstantBinaryPred AlwaysT2 AlwaysNIL2
ConstantUnaryPred OSetEqual BagEqual ListEqual MEMBER MEMB NOT)
Worth 500
IsA (MathConcept MathObj Anything Category)
Examples (T NIL)
FastDefn [LAMBDA (B)
(OR (EQ B NIL)
(EQ B T]
Generalizations (Anything))
(PUTPROPS Category Worth 500
IsA (Category Anything ReprConcept)
Examples (Set Heuristic Anything MathConcept Slot MathObj NNumber Unit PrimeNum
Conjecture ReprConcept EvenNum Task MathOp OddNum PerfNum
PerfSquare Op SetOfNumbers SetOp UnitOp NumOp CriterialSlot Pred
MathPred Bit NonCriterialSlot HindSightRule UnaryUnitOp RecordSlot
Structure Category ConstantPred StrucOp ListOp List Bag BagOp
MultEleStruc MultEleStrucOp OSet OSetOp NoMultEleStruc OrdStruc
UnOrdStruc OrdStrucOp TypeOfStructure UnaryOp BinaryOp TertiaryOp
OPair Pair InvertedOp SetOfOPairs Relation LogicOp Atom TruthValue
StructureOfStructures SetOfSets EmptyStruc NonEmptyStruc UnaryPred
BinaryPred TertiaryPred PredCatByNArgs OpCatByNArgs)
Specializations (TypeOfStructure PredCatByNArgs OpCatByNArgs)
Interestingness (Interp3 (QUOTE H24)
u
(QUOTE WhyInt)))
(PUTPROPS CompiledDefn SuperSlots (Defn)
Worth 600
IsA (Slot CriterialSlot ReprConcept Anything)
DataType CompiledLispCode)
(PUTPROPS Compose Worth 990
IsA (MathConcept MathOp Op Anything BinaryOp)
Arity 2
Domain (Op Op)
Range (Op)
ElimSlots (Applics)
FastAlg [LAMBDA (f g nam fargs gargs)
(COND ([AND (Range f)
(Domain g)
(IsAKindOf (CAR (Range f))
(CAR (Domain g]
(SETQ fargs
(MAP2CAR (Domain f)
(QUOTE (u v w x y z z2 z3 z4 z5))
(QUOTE TheSecondOf)))
(SETQ gargs
(MAP2CAR (CDR (Domain g))
(QUOTE (a b c d e f g h i j k))
(QUOTE TheSecondOf)))
(SETQ nam (CreateUnit (PACK* g (QUOTE -o-)
f)))
[PUT nam (QUOTE IsA)
(SetDiff (IsA g)
(Examples (QUOTE OpCatByNArgs]
(PUT nam (QUOTE Worth)
(AverageWorths (QUOTE Compose)
(AverageWorths f g)))
(PUT nam (QUOTE Arity)
(PLUS (LENGTH fargs)
(LENGTH gargs)))
[PUT nam (QUOTE Domain)
(APPEND (COPY (Domain f))
(CDR (Domain g]
(PUT nam (QUOTE Range)
(COPY (Range g)))
(PUT nam (QUOTE UnitizedAlg)
(LIST (QUOTE LAMBDA)
(NCONC (COPY fargs)
(COPY gargs))
(APPEND (LIST (QUOTE RunAlg)
(KWOTE g)
(APPEND (LIST (QUOTE RunAlg)
(KWOTE f))
fargs))
gargs)))
(PUT nam (QUOTE ElimSlots)
(LIST (QUOTE Applics)))
(PUT nam (QUOTE Creditors)
(LIST (QUOTE Compose)))
[PUT nam (QUOTE IsA)
(APPEND (IsA nam)
(SUBSET (Examples (QUOTE OpCatByNArgs))
(FUNCTION (LAMBDA (PC)
(RunDefn PC nam]
(AddInv nam)
nam)
(T (* we should check for cases where f could sub for other
than the first arg of g)
(QUOTE Failed]
Rarity (.3612903 56 99))
(PUTPROPS Conjecture Worth 500
Examples (ProtoConjec)
IsA (ReprConcept Anything Category)
Generalizations (Anything))
(PUTPROPS ConjectureAbout Worth 300
IsA (Slot NonCriterialSlot ReprConcept Anything)
DataType Unit
DoubleCheck T
DontCopy T
Inverse (Conjectures))
(PUTPROPS Conjectures Worth 300
IsA (Slot NonCriterialSlot ReprConcept Anything)
DataType Conjecture
DoubleCheck T
DontCopy T
Inverse (ConjectureAbout))
(PUTPROPS ConstantBinaryPred Worth 500
IsA (Op Pred Anything UnaryOp MathOp BinaryPred)
Arity 2
Domain (Anything)
Range (Bit)
ElimSlots (Applics)
Specializations (AlwaysT2 AlwaysNIL2))
(PUTPROPS ConstantPred Generalizations (Op Pred Anything)
Worth 500
IsA (Anything Category MathOp ReprConcept)
Examples (AlwaysT AlwaysNIL AlwaysT2 AlwaysNIL2))
(PUTPROPS ConstantUnaryPred Worth 500
IsA (Op Pred Anything UnaryOp MathOp UnaryPred)
Arity 1
Domain (Anything)
Range (Bit)
ElimSlots (Applics)
Specializations (AlwaysT AlwaysNIL))
(PUTPROPS Creditors ToDelete1 [LAMBDA (U1 P U2)
(* U1 is on the P property of unit U2, and is now being
deleted. We must remove accreditaion of U2 from the
Applics slot of U1)
(REM1PROP U1 (QUOTE Applics)
(CAR (SOME (Applics U1)
(FUNCTION (LAMBDA (a)
(EQ (CAADR a)
U2]
Worth 300
IsA (Slot NonCriterialSlot ReprConcept Anything)
DataType Unit)
(PUTPROPS CriterialSlot IsA (ReprConcept MathConcept Anything Category)
Worth 500
Generalizations (Slot Anything ReprConcept)
Examples (Alg ApplicGenerator CompiledDefn DataType Defn Domain ElimSlots
FastAlg FastDefn Generator IfAboutToWorkOnTask
IfFinishedWorkingOnTask IfParts IfPotentiallyRelevant
IfTaskParts IfTrulyRelevant IfWorkingOnTask IterativeAlg
IterativeDefn NonExamples RecursiveAlg RecursiveDefn
ThenAddToAgenda ThenCompute ThenConjecture
ThenDefineNewConcepts ThenModifySlots ThenParts
ThenPrintToUser ToDelete ToDelete1 UnitizedAlg UnitizedDefn
ThenDeleteOldConcepts NecDefn SufDefn EachElementIsA))
(PUTPROPS DataType Worth 600
IsA (Slot CriterialSlot ReprConcept Anything)
DataType DataType
DoubleCheck T)
(PUTPROPS Defn Worth 600
IsA (Slot CriterialSlot ReprConcept Anything)
DataType LispPred
SubSlots (CompiledDefn FastDefn IterativeDefn RecursiveDefn UnitizedDefn SufDefn
NecDefn)
Specializations (NecDefn SufDefn))
(PUTPROPS DirectApplics Worth 300
IsA (Slot NonCriterialSlot ReprConcept Anything)
Format ((situation resultant-units directness)
(situation resultant-units directness)
etc.)
DataType IOPair
SuperSlots (Applics)
DoubleCheck T
DontCopy T)
(PUTPROPS DivisorsOf Worth 500
IsA (MathConcept MathOp Op NumOp Anything UnaryOp)
FastAlg [LAMBDA (n)
(SORT (PROG ((i 1)
divi)
LOOP
(COND ((GREATERP (SQUARE i)
n)
(RETURN divi)))
[COND ((Divides i n)
(SETQ divi (CONS i (CONS (QUOTIENT n i)
divi]
(SETQ i (ADD1 i))
(GO LOOP]
IterativeAlg [LAMBDA (n)
(for i from 1 to n collect i when (Divides i n]
Domain (NNumber)
Range (SetOfNumbers)
ElimSlots (Applics)
Arity 1)
(PUTPROPS Domain Worth 600
IsA (Slot CriterialSlot ReprConcept Anything)
DataType Unit
Inverse (InDomainOf))
(PUTPROPS DontCopy Worth 300
IsA (Slot NonCriterialSlot ReprConcept Anything)
DataType Bit)
(PUTPROPS DoubleCheck Worth 300
IsA (Slot NonCriterialSlot ReprConcept Anything)
DataType Bit)
(PUTPROPS EQ Worth 507
IsA (MathConcept MathOp Op MathPred Pred Anything BinaryOp BinaryPred)
FastAlg [LAMBDA (X Y)
(EQ X Y]
Arity 2
Domain (Anything Anything)
Range (Bit)
Generalizations (EQUAL)
ElimSlots (Applics)
IsAInt (BinaryPred)
Rarity (.1 1 9))
(PUTPROPS EQUAL Worth 502
IsA (MathConcept MathOp Op MathPred Pred Anything BinaryOp BinaryPred)
FastAlg [LAMBDA (X Y)
(EQUAL X Y]
Arity 2
Domain (Anything Anything)
Range (Bit)
Specializations (IEQP EQ StrucEqual SetEqual OSetEqual BagEqual ListEqual)
ElimSlots (Applics))
(PUTPROPS ElimSlots Worth 600
IsA (Slot CriterialSlot ReprConcept Anything)
DataType Slot
DoubleCheck T)
(PUTPROPS English Worth 304
IsA (Slot NonCriterialSlot ReprConcept Anything)
DataType Text)
(PUTPROPS EvenNum Generalizations (NNumber Anything)
Worth 800
UnitizedDefn [LAMBDA (n)
(RunAlg (QUOTE Divides)
2 n]
IsA (MathConcept MathObj Anything Category)
FastDefn [LAMBDA (n)
(AND (FIXP n)
(Divides 2 n]
ElimSlots (Examples))
(PUTPROPS Examples Worth 300
IsA (Slot NonCriterialSlot ReprConcept Anything)
Inverse (IsA)
DataType Unit
DoubleCheck T
DontCopy T
SubSlots (IntExamples)
MoreInteresting (IntExamples))
(PUTPROPS FailedRecord Worth 600
IsA (Slot NonCriterialSlot ReprConcept Anything)
DoubleCheck T
DataType Slot
Inverse (FailedRecordFor))
(PUTPROPS FailedRecordFor Worth 600
IsA (Slot NonCriterialSlot ReprConcept Anything)
DoubleCheck T
DataType Slot
Inverse (FailedRecord))
(PUTPROPS FastAlg SuperSlots (Alg)
IsA (Slot CriterialSlot ReprConcept Anything)
Worth 600
DataType LispFn
DontCopy T)
(PUTPROPS FastDefn SuperSlots (Defn)
Worth 600
IsA (Slot CriterialSlot ReprConcept Anything)
DataType LispPred)
(PUTPROPS Format Worth 300
IsA (Slot NonCriterialSlot ReprConcept Anything)
DataType DataType)
(PUTPROPS Generalizations Worth 306
IsA (Slot NonCriterialSlot ReprConcept Anything)
SubSlots (SuperSlots Extensions)
Inverse (Specializations)
DataType Unit
DoubleCheck T)
(PUTPROPS Generator Worth 600
IsA (Slot CriterialSlot ReprConcept Anything)
DataType LispFn
Format (GenInit GenBuild GenArgs))
(PUTPROPS GoodChoose Worth 500
IsA (MathConcept MathOp Op SetOp Anything StrucOp UnaryOp)
FastAlg GoodChoose
Domain (Set)
Range (Anything)
Generalizations (RandomChoose)
Specializations (BestChoose)
ElimSlots (Applics)
Arity 1)
(PUTPROPS GoodSubset Worth 500
IsA (MathConcept MathOp Op SetOp Anything StrucOp UnaryOp)
FastAlg GoodSubset
Domain (Set)
Range (Set)
Generalizations (RandomSubset)
Specializations (BestSubset)
ElimSlots (Applics)
Arity 1)
(PUTPROPS H1 IsA (Heuristic Op Anything)
English (IF an op f (e.g., a mathematical function, a heuristic, etc.)
has had some good applications, but over 4/5 are bad, THEN conjecture that
some Specializations of f may be superior to f, and add tasks to
specialize f to the Agenda)
IfPotentiallyRelevant [LAMBDA (f)
(* check that f has some recorded applications -- which
implies, of course, that f is an
executable/performable entity)
(Applics f]
IfTrulyRelevant [LAMBDA (f)
(* check that some Applics of f have high Worth, but most have
low Worth)
(* the extent to which those conditions are met will determine
the amount of energy to expend working on applying this
rule -- its overall relevancy)
(AND [SOME (Applics f)
(QUOTE (LAMBDA (a)
(* this will have the format
(args results))
(SOME (CADR a)
(QUOTE HasHighWorth]
[GREATERP .2 (SETQ Fraction (FractionOf
(MapUnion (Applics f)
(QUOTE CADR))
(QUOTE HasHighWorth]
(NOT (SubsumedBy f]
Worth 724
Applics (((sit1)
(win1 los1))
((sit2)
(los2 los3 los4 los5 los6))
((TaskNum: 244)
(H19Criterial)
3)
((TaskNum: 23)
(H5Criterial)
3)
((TaskNum: 23)
(H5Good)
3))
Abbrev (Specialize a sometimes-useful action)
ThenPrintToUser [LAMBDA (f)
(CPRIN1 13 "
" conjec ":" "
Since some specializations of " f " " (CONS "i.e., " (Abbrev f))
" are quite valuable, but over four-fifths are trash, EURISKO has recognized the value of finding new concepts similar to -- but more specialized than -- "
f
", and (to that end) has added a new task to the agenda to find such specializations. ")
T]
ThenConjecture [LAMBDA
(f)
(SETQ Conjectures
(CONS (PROGN (SETQ conjec (NewNam (QUOTE Conjec)))
(CreateUnit conjec (QUOTE ProtoConjec))
[PUT conjec (QUOTE English)
(NCONC (LIST (QUOTE Specializations)
(QUOTE of)
f)
(APPEND (QUOTE (may be more useful
than it is, since
it has some good
instances but many
more poor ones)))
(LIST (LIST (Percentify (DIFFERENCE
1.0 Fraction)
)
(QUOTE are)
(QUOTE losers]
[PUT conjec (QUOTE Abbrev)
(CONS f
(QUOTE (sometimes wins, usually loses,
so specializations of
it may win big]
[PUT conjec (QUOTE Worth)
(FIX (Average (NearnessTo Fraction .1)
(AverageWorths (QUOTE H1)
f]
conjec)
Conjectures]
ThenAddToAgenda [LAMBDA (f)
(SETQ Agenda (MergeTasks
[LIST (LIST (AverageWorths f (QUOTE H1))
f
(QUOTE Specializations)
(LIST conjec)
(LIST (LIST (QUOTE CreditTo)
(QUOTE H1]
Agenda))
(AddPropL TaskResults (QUOTE NewTasks)
(QUOTE (1 unit must be specialized]
ThenConjectureRecord (2393 . 5)
ThenAddToAgendaRecord (377 . 5)
ThenPrintToUserRecord (2601 . 5)
OverallRecord (7078 . 5)
Arity 1)
(PUTPROPS H10 IsA (Heuristic Op Anything)
English (IF the current task is to find examples of a unit, and it is the range of
some operation f, THEN gather together the outputs of the I/O pairs
stored on Applics of f)
IfPotentiallyRelevant NULL
Worth 700
Abbrev (If C is Range (f)
, then Exs (C)
can be gotten from Applics (f))
IfWorkingOnTask [LAMBDA (task)
(AND (EQ CurSlot (QUOTE Examples))
(SETQ OpToUse (RandomChoose (IsRangeOf CurUnit]
ThenPrintToUser [LAMBDA (task)
(CPRIN1 13 CRLF "Instantiated " CurUnit "; there are now "
(LENGTH (Examples CurUnit))
" "
(QUOTE Examples)
CRLF)
(CPRIN1 48 " The new ones are: " NewValues CRLF)
T]
ThenCompute [LAMBDA (task)
(SETQ CurVal (APPLY* CurSlot CurUnit))
[AND (SETQ SpaceToUse (Applics OpToUse))
(MAPC SpaceToUse (FUNCTION
(LAMBDA (Z)
(SETQ Z (ExtractOutput Z))
(AND (NOT (MEMBER Z (Examples CurUnit)))
(NOT (MEMBER Z (NonExamples CurUnit)))
(CPRIN1 58 (QUOTE +))
(UnionProp CurUnit (QUOTE Examples)
Z]
(AND (SETQ NewValues (SetDifference (Examples CurUnit)
CurVal))
(SETQ TaskResults (CONS (LIST (QUOTE NewValues)
(LIST CurUnit CurSlot
NewValues
(LIST (QUOTE By)
(QUOTE examining)
(QUOTE Applics)
(QUOTE of)
OpToUse
(QUOTE ,)
(QUOTE Eurisko)
(QUOTE found)
(LENGTH NewValues)
(QUOTE Examples)
(QUOTE of)
CurUnit)))
TaskResults)))
(* this always returns T ; if the SpaceToUse was null, then
ThenAddToAgenda will want to add a task to the agenda to help
correct that situation)
T]
ThenAddToAgenda [LAMBDA
(task)
(COND
(SpaceToUse (* There were some Applics of OpToUse)
T)
(T (SETQ Agenda
(MergeTasks
(LIST [LIST (SUB1 CurPri)
OpToUse
(QUOTE Applics)
[LIST (SUBST CurUnit (QUOTE CU)
(QUOTE (Recent task was
stymied for
lack of such
applics;
namely, trying
to find
Examples of CU]
(LIST (LIST (QUOTE CreditTo)
(QUOTE H10]
(LIST (IQUOTIENT CurPri 2)
CurUnit CurSlot
(LIST (LIST (QUOTE Had)
(QUOTE to)
(QUOTE suspend)
(QUOTE whilst)
(QUOTE gathering)
(QUOTE Applics)
(QUOTE of)
OpToUse)
(CAR CurReasons))
CurSup))
Agenda))
[SETQ TaskResults (AddPropL TaskResults (QUOTE NewTasks)
(LIST 1 (QUOTE task)
(QUOTE to)
(QUOTE find)
(QUOTE Applics)
(QUOTE of)
OpToUse
(QUOTE and)
1
(QUOTE task)
(QUOTE just)
(QUOTE like)
(QUOTE the)
(QUOTE current)
(QUOTE one]
(CPRIN1 40 CRLF
"Hmmm... can't proceed with this until some Applics of "
OpToUse " are known." CRLF)
NIL]
ThenComputeRecord (12618 . 7)
ThenAddToAgendaFailedRecord (1307 . 3)
ThenAddToAgendaRecord (37 . 4)
ThenPrintToUserRecord (2101 . 4)
OverallRecord (16037 . 4)
Arity 1)
(PUTPROPS H11 IsA (Heuristic Op Anything)
English (IF the current task is to find application-instances of a unit f, and it has
an Algorithm for computing its values, and it has a Domain, THEN choose
examples of its domain component/s, and run the alg for f on such inputs)
IfPotentiallyRelevant NULL
Worth 700
Abbrev (Applics (f)
may be found by running Alg (f)
on members of u's Domain)
IfWorkingOnTask [LAMBDA (task)
(AND (EQ CurSlot (QUOTE Applics))
(SETQ AlgToUse (Alg CurUnit))
(SETQ SpaceToUse (Domain CurUnit]
ThenPrintToUser [LAMBDA (task)
(CPRIN1 13 CRLF "Instantiated " CurUnit "; found "
(LENGTH NewValues)
" "
(QUOTE Applics)
CRLF)
(CPRIN1 48 " Namely: " NewValues CRLF)
T]
ThenCompute [LAMBDA
(task Args Failed)
[* (PUTD (QUOTE APPLYTOUSE)
(GETD (COND ((AND (Arity CurUnit)
(IGREATERP (Arity CurUnit)
1))
(QUOTE APPLY))
(T (QUOTE APPLY*]
(SETQ CurVal (APPLY* CurSlot CurUnit))
(SETQ DomainTests (MAPCAR (Domain CurUnit)
(QUOTE Defn)))
(SETQ MaxRuleTime
(PLUS (CLOCK 0)
(TIMES CurPri UserImpatience
[ADD1 (FIX (PLUS .5 (LOG (MAX 2 (ADD1 Verbosity]
5)))
[SETQ MaxRuleSpace (ITIMES 2 (IPLUS (Average CurPri 1000)
(COUNT (GETPROP CurUnit CurSlot]
(SETQ RuleCycleTime (CLOCK 0))
(SELECTQ
(LENGTH DomainTests)
(0 (for j from 1 to 100 do [AND (NOT (KnownApplic CurUnit NIL))
(CPRIN1 62 (QUOTE +))
(UnionProp CurUnit (QUOTE Applics)
(LIST NIL
(APPLY* AlgToUse NIL]
until
(RuleTakingTooLong)
finally
(SETQ NTried j)))
[1
(COND
((Generator (CAR (Domain CurUnit)))
(SETQ NTried 0)
(MapExamples (CAR (Domain CurUnit))
[FUNCTION (LAMBDA
(A)
(AND (NOT (KnownApplic CurUnit
(LIST A)))
(APPLY* (CAR DomainTests)
A)
(CPRIN1 62 (QUOTE +))
(SETQ NTried (ADD1 NTried))
(UnionProp CurUnit (QUOTE Applics)
(LIST (LIST A)
(APPLY* AlgToUse
A]
200))
(T
(for
j from 1 to 50 do
[AND [SETQ
Args
(MAPCAR SpaceToUse
(FUNCTION
(LAMBDA
(D tmp)
(COND
((Generator D)
(PROG (lastgen)
(MapExamples
D
(FUNCTION [LAMBDA (E)
(SETQ lastgen
E])
(RAND 1 100))
(RETURN lastgen)))
((Examples D)
(RandomChoose (Examples D)))
([SETQ tmp (Examples
(RandomChoose (Specializations
D]
(RandomChoose tmp))
((PUT D (QUOTE Examples)
(GatherExamples D))
[SETQ
TempCaches
(CONS (LIST (QUOTE REMPROP)
(KWOTE D)
(QUOTE (QUOTE Examples]
(RandomChoose (Examples D)))
(T (SETQ Failed T)
NIL]
(NOT Failed)
(NOT (KnownApplic CurUnit Args))
(for DT in DomainTests as A in Args always
(APPLY* DT A))
[UnionProp CurUnit (QUOTE Applics)
[LIST Args
(CAR (SETQ MaybeFailed
(ERRORSET
(QUOTE (APPLY AlgToUse
Args))
(QUOTE NOBREAK]
NIL
(SETQ MaybeFailed (OR (NULL MaybeFailed)
(EQ (CAR MaybeFailed)
(QUOTE Failed]
(CPRIN1 62 (COND (MaybeFailed (QUOTE -))
(T (QUOTE +]
until
(RuleTakingTooLong)
finally
(SETQ NTried j]
(for j from 1 to 50 do
[AND [SETQ Args
(MAPCAR SpaceToUse
(FUNCTION
(LAMBDA
(D tmp)
(COND
((Generator D)
(PROG (lastgen)
(MapExamples
D
(FUNCTION [LAMBDA (E)
(SETQ
lastgen E])
(RAND 1 50))
(RETURN lastgen)))
((Examples D)
(RandomChoose (Examples D)))
([SETQ tmp (Examples
(RandomChoose (Specializations
D]
(RandomChoose tmp))
((PUT D (QUOTE Examples)
(GatherExamples D))
[SETQ
TempCaches
(CONS (LIST (QUOTE REMPROP)
(KWOTE D)
(QUOTE (QUOTE Examples]
(RandomChoose (Examples D)))
(T (SETQ Failed T)
NIL]
(NOT Failed)
(NOT (KnownApplic CurUnit Args))
(for DT in DomainTests as A in Args always
(APPLY* DT A))
[UnionProp CurUnit (QUOTE Applics)
[LIST Args
(CAR (SETQ MaybeFailed
(ERRORSET (QUOTE (APPLY
AlgToUse
Args))
(QUOTE NOBREAK]
NIL
(SETQ MaybeFailed (OR (NULL MaybeFailed)
(EQ (CAR MaybeFailed)
(QUOTE Failed]
(CPRIN1 62 (COND (MaybeFailed (QUOTE -))
(T (QUOTE +]
until
(RuleTakingTooLong)
finally
(SETQ NTried j)))
(AND (SETQ NewValues (SetDifference (Applics CurUnit)
CurVal))
(SETQ TaskResults (CONS [LIST (QUOTE NewValues)
(LIST CurUnit CurSlot NewValues
(LIST (QUOTE By)
(QUOTE running)
(QUOTE algorithm)
(QUOTE for)
CurUnit
(QUOTE on)
(QUOTE random)
(QUOTE examples)
(QUOTE from)
(Domain CurUnit)
(QUOTE ,)
(LENGTH NewValues)
(QUOTE were)
(QUOTE found]
TaskResults))
(SETQ CurVal (APPLY* CurSlot CurUnit))
(PUT CurUnit (QUOTE Rarity)
(PROGN (SETQ RCU (Rarity CurUnit))
(SETQ nT (AddNN (LENGTH NewValues)
(CADR RCU)))
(SETQ nF (AddNN (DIFFERENCE NTried (LENGTH NewValues))
(CADDR RCU)))
(LIST (QUOTIENT (FLOAT nT)
(IPLUS nT nF))
nT nF]
ThenComputeRecord (2296694 . 66)
ThenPrintToUserRecord (47517 . 66)
OverallRecord (2369179 . 66)
ThenComputeFailedRecord (1319487 . 23)
Arity 1)
(PUTPROPS H12 IsA (HindSightRule Heuristic Op Anything)
English (IF C is about to die, then try to form a new heuristic, one which -- had it
existed earlier -- would have prevented C from ever being defined in the
first place)
IfPotentiallyRelevant [LAMBDA (f)
(MEMB f DeletedUnits]
Worth 700
Abbrev (Form a rule that would have prevented this mistake)
ThenPrintToUser [LAMBDA (task)
(CPRIN1 13 CRLF CRLF
"Just before destroying a losing concept, Eurisko generalized from that bad experience, in the following way: "
"Eurisko will no longer alter the " CSlot
" slot of a unit "
"when trying to find " GSlot
" of that unit. We learned our lesson from "
ArgU CRLF CRLF]
ThenCompute [LAMBDA
(C)
(AND
[SETQ
CSlot
(CADR
(ASSOC
(QUOTE SlotToChange)
(CAR (CDDDDR (SETQ
CTask
(CADDAR
(CAR (SOME (Applics (CAR (Creditors C)))
(FUNCTION (LAMBDA
(A)
(MEMB C (CADR A]
(SETQ GSlot (CADDR CTask))
(OR (ILEQ (LENGTH (SETQ CSlotSibs (SibSlots CSlot)))
50)
(SETQ CSlotSibs (LIST CSlot)))
(OR CSlotSibs (SETQ CSlotSibs (LIST CSlot]
ThenDefineNewConcepts [LAMBDA (task)
(SETQ NewUnit (CreateUnit (QUOTE HAvoid)
(QUOTE HAvoid)))
(SETPROPLIST NewUnit
(SUBPAIR (QUOTE (GSlot CSlot CSlotSibs
NotForReal))
(LIST GSlot CSlot CSlotSibs T)
(GETPROPLIST NewUnit)))
(SETQ NewUnits (CDR (ASSOC (QUOTE NewUnits)
TaskResults)))
[COND (NewUnits (NCONC1 NewUnits NewUnit))
(T (SETQ TaskResults (CONS (LIST (QUOTE NewUnits)
NewUnit)
TaskResults]
[ADDPROP (QUOTE H12)
(QUOTE Applics)
(LIST (LIST (QUOTE TaskNum:)
TaskNum task (DATE))
(LIST NewUnit)
(InitializeCreditAssignment)
(LIST (QUOTE WillAvoid)
CSlot
(QUOTE slot)
(COND ((CDR CSlotSibs)
(LIST (QUOTE ,)
(QUOTE actually)
(QUOTE all)
(QUOTE of)
(QUOTE these:)
CSlotSibs
(QUOTE ,)))
(T (QUOTE ,)))
(QUOTE of)
(QUOTE units)
(QUOTE whenever)
(QUOTE finding)
GSlot
(QUOTE of)
(QUOTE them]
[MAPC (SETQ Creditors (CDR (ASSOC (QUOTE CreditTo)
CurSup)))
(FUNCTION (LAMBDA
(H)
(ADDPROP H (QUOTE Applics)
(LIST (LIST (QUOTE TaskNum:)
TaskNum task
(DATE))
(LIST NewUnit)
(
DecrementCreditAssignment]
(PUT NewUnit (QUOTE Creditors)
(SETQ Creditors (CONS (QUOTE H12)
Creditors)))
T]
Applics [((TaskNum: 87 (H1-11 Applics)
"29-Mar-81 16:36:00")
(HAvoidIfWorking)
1
(Specialized HAvoid as follows: ((CFrom -> AND)
(CTo -> TheFirstOf)
(CSlot -> IfWorkingOnTask)
(CSlotSibs -> (IfPotentiallyRelevant IfTrulyRelevant
IfAboutToWorkOnTask
IfWorkingOnTask
IfFinishedWorkingOnTask))
(GSlot -> Generalizations]
Arity 1)
(PUTPROPS H13 IsA (HindSightRule Heuristic Op Anything)
English (IF C is about to die, then try to form a new heuristic, one which -- had it
existed earlier -- would have prevented C from ever being defined in the
first place , by preventing the kind of changed object from being changed)
IfPotentiallyRelevant [LAMBDA (f)
(MEMB f DeletedUnits]
Worth 700
Abbrev (Form a rule that would have prevented this mistake)
ThenPrintToUser [LAMBDA (task)
(CPRIN1 13 CRLF CRLF
"Just before destroying a losing concept, Eurisko generalized from that bad experience, in the following way: "
"Eurisko will no longer alter the " CFrom
" inside any of these "
CSlotSibs " slots of a unit " "when trying to find "
GSlot " of that unit. We learned our lesson from "
ArgU CRLF CRLF]
ThenCompute [LAMBDA
(C)
(AND
[SETQ
CSlot
(CADR
(ASSOC
(QUOTE SlotToChange)
(CAR
(CDDDDR (SETQ
CTask
(CADDAR (SETQ
CTRes
(CAR (SOME (Applics (CAR (Creditors
C)))
(FUNCTION
(LAMBDA (A)
(MEMB C
(CADR A]
(SETQ GSlot (CADDR CTask))
(OR (ILEQ (LENGTH (SETQ CSlotSibs (SibSlots CSlot)))
50)
(SETQ CSlotSibs (LIST CSlot)))
(OR CSlotSibs (SETQ CSlotSibs (LIST CSlot)))
(SOME (CAR (LAST CTRes))
(FUNCTION (LAMBDA (Z)
(COND ((NLISTP Z)
NIL)
((EQ (CADR Z)
RArrow)
(SETQ CFrom (CAR Z))
(SETQ CTo (CADDR Z))
T)
(T NIL]
ThenDefineNewConcepts [LAMBDA (task)
(SETQ NewUnit (CreateUnit (QUOTE HAvoid2)
(QUOTE HAvoid2)))
(SETPROPLIST NewUnit
(SUBPAIR (QUOTE (GSlot CSlot CSlotSibs
NotForReal CFrom
CTo))
(LIST GSlot CSlot CSlotSibs T
CFrom CTo)
(GETPROPLIST NewUnit)))
(SETQ NewUnits (CDR (ASSOC (QUOTE NewUnits)
TaskResults)))
[COND (NewUnits (NCONC1 NewUnits NewUnit))
(T (SETQ TaskResults (CONS (LIST (QUOTE NewUnits)
NewUnit)
TaskResults]
[ADDPROP (QUOTE H13)
(QUOTE Applics)
(LIST (LIST (QUOTE TaskNum:)
TaskNum task (DATE))
(LIST NewUnit)
(InitializeCreditAssignment)
(LIST (QUOTE WillAvoid)
(QUOTE changing)
(QUOTE a)
CFrom
(QUOTE inside)
(QUOTE the)
CSlot
(QUOTE slot)
(COND ((CDR CSlotSibs)
(LIST (QUOTE ,)
(QUOTE actually)
(QUOTE all)
(QUOTE of)
(QUOTE these:)
CSlotSibs
(QUOTE ,)))
(T (QUOTE ,)))
(QUOTE of)
(QUOTE units)
(QUOTE whenever)
(QUOTE finding)
GSlot
(QUOTE of)
(QUOTE them]
[MAPC (SETQ Creditors (CDR (ASSOC (QUOTE CreditTo)
CurSup)))
(FUNCTION (LAMBDA
(H)
(ADDPROP H (QUOTE Applics)
(LIST (LIST (QUOTE TaskNum:)
TaskNum task
(DATE))
(LIST NewUnit)
(
DecrementCreditAssignment]
(PUT NewUnit (QUOTE Creditors)
(SETQ Creditors (CONS (QUOTE H13)
Creditors)))
T]
Applics [((TaskNum: 87 (H1-11 Applics)
"29-Mar-81 16:36:06")
(HAvoid2AND)
1
(Specialized HAvoid2 as follows: ((CFrom -> AND)
(CTo -> TheFirstOf)
(CSlot -> IfWorkingOnTask)
(CSlotSibs -> (IfPotentiallyRelevant IfTrulyRelevant
IfAboutToWorkOnTask
IfWorkingOnTask
IfFinishedWorkingOnTask))
(GSlot -> Generalizations]
Arity 1)
(PUTPROPS H14 IsA (HindSightRule Heuristic Op Anything)
English (IF C is about to die, then try to form a new heuristic, one which -- had it
existed earlier -- would have prevented C from ever being defined in the
first place , by preventing the same losing sort of entity being the
replacer)
IfPotentiallyRelevant [LAMBDA (f)
(MEMB f DeletedUnits]
Worth 700
Abbrev (Form a rule that would have prevented this mistake)
ThenPrintToUser [LAMBDA (task)
(CPRIN1 13 CRLF CRLF
"Just before destroying a losing concept, Eurisko generalized from that bad experience, in the following way: "
"Eurisko will no longer change something into " CTo
" inside any of these "
CSlotSibs " slots of a unit " "when trying to find "
GSlot " of that unit. We learned our lesson from "
ArgU CRLF CRLF]
ThenCompute [LAMBDA
(C)
(AND
[SETQ
CSlot
(CADR
(ASSOC
(QUOTE SlotToChange)
(CAR
(CDDDDR (SETQ
CTask
(CADDAR (SETQ
CTRes
(CAR (SOME (Applics (CAR (Creditors
C)))
(FUNCTION
(LAMBDA (A)
(MEMB C
(CADR A]
(SETQ GSlot (CADDR CTask))
(OR (ILEQ (LENGTH (SETQ CSlotSibs (SibSlots CSlot)))
50)
(SETQ CSlotSibs (LIST CSlot)))
(OR CSlotSibs (SETQ CSlotSibs (LIST CSlot)))
(SOME (CAR (LAST CTRes))
(FUNCTION (LAMBDA (Z)
(COND ((EQ (CADR Z)
RArrow)
(SETQ CFrom (CAR Z))
(SETQ CTo (CADDR Z))
T)
(T NIL]
ThenDefineNewConcepts [LAMBDA (task)
(SETQ NewUnit (CreateUnit (QUOTE HAvoid3)
(QUOTE HAvoid3)))
(SETPROPLIST NewUnit
(SUBPAIR (QUOTE (GSlot CSlot CSlotSibs
NotForReal CFrom
CTo))
(LIST GSlot CSlot CSlotSibs T
CFrom CTo)
(GETPROPLIST NewUnit)))
(SETQ NewUnits (CDR (ASSOC (QUOTE NewUnits)
TaskResults)))
[COND (NewUnits (NCONC1 NewUnits NewUnit))
(T (SETQ TaskResults (CONS (LIST (QUOTE NewUnits)
NewUnit)
TaskResults]
[ADDPROP (QUOTE H14)
(QUOTE Applics)
(LIST (LIST (QUOTE TaskNum:)
TaskNum task (DATE))
(LIST NewUnit)
(InitializeCreditAssignment)
(LIST (QUOTE WillAvoid)
(QUOTE changing)
(QUOTE anything)
(QUOTE into)
(QUOTE a)
CTo
(QUOTE inside)
(QUOTE the)
CSlot
(QUOTE slot)
(COND ((CDR CSlotSibs)
(LIST (QUOTE ,)
(QUOTE actually)
(QUOTE all)
(QUOTE of)
(QUOTE these:)
CSlotSibs
(QUOTE ,)))
(T (QUOTE ,)))
(QUOTE of)
(QUOTE units)
(QUOTE whenever)
(QUOTE finding)
GSlot
(QUOTE of)
(QUOTE them]
[MAPC (SETQ Creditors (CDR (ASSOC (QUOTE CreditTo)
CurSup)))
(FUNCTION (LAMBDA
(H)
(ADDPROP H (QUOTE Applics)
(LIST (LIST (QUOTE TaskNum:)
TaskNum task
(DATE))
(LIST NewUnit)
(
DecrementCreditAssignment]
(PUT NewUnit (QUOTE Creditors)
(SETQ Creditors (CONS (QUOTE H14)
Creditors)))
T]
Applics [((TaskNum: 87 (H1-11 Applics)
"29-Mar-81 16:36:33")
(HAvoid3First)
1
(Specialized HAvoid3 as follows: ((CFrom -> AND)
(CTo -> TheFirstOf)
(CSlot -> IfWorkingOnTask)
(CSlotSibs -> (IfPotentiallyRelevant IfTrulyRelevant
IfAboutToWorkOnTask
IfWorkingOnTask
IfFinishedWorkingOnTask))
(GSlot -> Generalizations]
Arity 1)
(PUTPROPS H15 IsA (Heuristic Op Anything)
English (IF the current task is to find examples of a unit, and it is the range of
some operations f, THEN gather together the outputs of the I/O pairs
stored on Applics of f)
IfPotentiallyRelevant NULL
Worth 700
Abbrev (If C is Range (f)
, then Exs (C)
can be gotten from Applics (f))
IfWorkingOnTask [LAMBDA (task)
(AND (EQ CurSlot (QUOTE Examples))
(SETQ OpsToUse (IsRangeOf CurUnit]
ThenPrintToUser [LAMBDA (task)
(CPRIN1 13 CRLF "Instantiated " CurUnit "; there are now "
(LENGTH (Examples CurUnit))
" "
(QUOTE Examples)
CRLF)
(CPRIN1 48 " The new ones are: " NewValues CRLF)
T]
ThenCompute [LAMBDA (task)
(SETQ CurVal (APPLY* CurSlot CurUnit))
[AND (SETQ SpaceToUse (MapUnion OpsToUse (QUOTE Applics)))
(MAPC SpaceToUse (FUNCTION
(LAMBDA (Z)
(SETQ Z (ExtractOutput Z))
(AND (NOT (MEMBER Z (Examples CurUnit)))
(NOT (MEMBER Z (NonExamples CurUnit)))
(CPRIN1 58 (QUOTE +))
(UnionProp CurUnit (QUOTE Examples)
Z]
(AND (SETQ NewValues (SetDifference (Examples CurUnit)
CurVal))
(SETQ TaskResults (CONS (LIST (QUOTE NewValues)
(LIST CurUnit CurSlot
NewValues
(LIST (QUOTE By)
(QUOTE examining)
(QUOTE Applics)
(QUOTE of)
OpsToUse
(QUOTE ,)
(QUOTE Eurisko)
(QUOTE found)
(LENGTH NewValues)
(QUOTE Examples)
(QUOTE of)
CurUnit)))
TaskResults)))
(* this always returns T ; if the SpaceToUse was null, then
ThenAddToAgenda will want to add a task to the agenda to help
correct that situation)
T]
ThenAddToAgenda [LAMBDA
(task)
(COND
(SpaceToUse (* There were some Applics of OpToUse)
T)
(T
(SETQ
Agenda
(MergeTasks
[CONS (LIST (IQUOTIENT CurPri 2)
CurUnit CurSlot (LIST (LIST (QUOTE Had)
(QUOTE to)
(QUOTE suspend)
(QUOTE whilst)
(QUOTE gathering)
(QUOTE Applics)
(QUOTE of)
OpsToUse)
(CAR CurReasons))
CurSup)
(MAPCAR OpsToUse
(FUNCTION
(LAMBDA
(OTU)
(LIST (SUB1 CurPri)
OTU
(QUOTE Applics)
[LIST (SUBST CurUnit (QUOTE CU)
(QUOTE (Recent task
was
stymied for
lack of
such
applics;
namely,
trying to
find
Examples of
CU]
(LIST (LIST (QUOTE CreditTo)
(QUOTE H15]
Agenda))
[SETQ TaskResults (AddPropL TaskResults (QUOTE NewTasks)
(LIST (LENGTH OpsToUse)
(QUOTE task)
(QUOTE to)
(QUOTE find)
(QUOTE Applics)
(QUOTE of)
OpsToUse
(QUOTE and)
1
(QUOTE task)
(QUOTE just)
(QUOTE like)
(QUOTE the)
(QUOTE current)
(QUOTE one]
(CPRIN1 40 CRLF
"Hmmm... can't proceed with this until some Applics of "
OpsToUse " are known." CRLF)
NIL]
ThenComputeRecord (5368 . 7)
ThenAddToAgendaFailedRecord (3302 . 3)
ThenAddToAgendaRecord (36 . 4)
ThenPrintToUserRecord (1201 . 4)
OverallRecord (7825 . 4)
Arity 1)
(PUTPROPS H16 IsA (Heuristic Anything Op)
English (IF the results of performing f are sometimes
(at least one time in ten)
useful , THEN consider creating new generalizations of f)
IfPotentiallyRelevant [LAMBDA (f)
(* check that f has some recorded applications -- which
implies, of course, that f is an
executable/performable entity)
(Applics f]
IfTrulyRelevant [LAMBDA (f)
(* check that some Applics of f have high Worth, but most
have low Worth)
(* the extent to which those conditions are met will
determine the amount of energy to expend working on
applying this rule -- its overall relevancy)
(AND [SOME (Applics f)
(QUOTE (LAMBDA (a)
(* this will have the format
(args results))
(SOME (CADR a)
(QUOTE HasHighWorth]
(GREATERP (SETQ Fraction (FractionOf
(MapUnion (Applics f)
(QUOTE CADR))
(QUOTE HasHighWorth)))
.1)
(NOT (SubsumedBy f]
Worth 600
Abbrev (Generalize a sometimes-useful action)
ThenPrintToUser [LAMBDA (f)
(CPRIN1 13 "
" conjec ":" "
Since some applications of " f " " (CONS "i.e., " (Abbrev f))
" are very valuable, so EURISKO wants to find new concepts which are slightly more generalized than "
f
", and (to that end) has added a new task to the agenda to find such concepts. ")
T]
ThenConjecture [LAMBDA (f)
(SETQ Conjectures
(CONS (PROGN (SETQ conjec (NewNam (QUOTE Conjec)))
(CreateUnit conjec (QUOTE ProtoConjec))
[PUT conjec (QUOTE English)
(NCONC (LIST (QUOTE Generalizations)
(QUOTE of)
f)
(APPEND (QUOTE (may be very
valuable in
the long
run , since
it already
has some
good
applications)))
(LIST (LIST (Percentify
Fraction)
(QUOTE are)
(QUOTE winners]
[PUT conjec (QUOTE Abbrev)
(CONS f
(QUOTE (sometimes wins, so
generalizations of
it may be very
big winners]
(PUT conjec (QUOTE Worth)
(AverageWorths (QUOTE H16)
f))
conjec)
Conjectures]
ThenAddToAgenda [LAMBDA (f)
(SETQ Agenda (MergeTasks
[LIST (LIST (AverageWorths f (QUOTE H16))
f
(QUOTE Generalizations)
(LIST conjec)
(LIST (LIST (QUOTE CreditTo)
(QUOTE H16]
Agenda))
(AddPropL TaskResults (QUOTE NewTasks)
(QUOTE (1 unit must be generalized]
ThenConjectureRecord (653 . 4)
ThenAddToAgendaRecord (90 . 4)
ThenPrintToUserRecord (622 . 4)
OverallRecord (1756 . 4)
Arity 1)
(PUTPROPS H17 IsA (Heuristic Anything Op)
English (IF the current task is to generalize a unit, and no general slot has been
chosen to be the one changed, THEN randomly select which slots to
generalize)
IfPotentiallyRelevant NULL
Worth 600
Abbrev (Generalize u by generalizing some random slots)
IfWorkingOnTask [LAMBDA (task)
(AND (IsAKindOf CurSlot (QUOTE Generalizations))
(NULL (ASSOC (QUOTE SlotToChange)
CurSup))
(IGEQ 7 (TheNumberOf Agenda
(FUNCTION
(LAMBDA
(Z)
(AND (EQ CurUnit (
ExtractUnitName
Z))
(EQ CurSlot (
ExtractSlotName
Z]
ThenPrintToUser [LAMBDA (task)
(CPRIN1 13 CRLF CurUnit
" will be generalized by generalizing the following of its slots: "
SlotsToChange CRLF CRLF)
T]
ThenAddToAgenda [LAMBDA
(task)
(SETQ
Agenda
(MergeTasks
(SORT [MAPCAR SlotsToChange
(FUNCTION
(LAMBDA
(S)
(LIST (Average CurPri (AverageWorths
S
(QUOTE H17)))
CurUnit CurSlot
(CONS (SETQ NewReason
(LIST
"A new unit will be created by generalizing the "
S " slot of " CurUnit
"; that slot was chosen randomly."))
NIL)
(LIST (LIST (QUOTE SlotToChange)
S)
(CONS (QUOTE CreditTo)
(CONS (QUOTE H17)
CreditTo]
(QUOTE OrderTasks))
Agenda))
(SETQ TaskResults (AddPropL TaskResults (QUOTE NewTasks)
(LIST (LENGTH SlotsToChange)
(QUOTE specific)
(QUOTE slots)
(QUOTE of)
CurUnit
(QUOTE to)
(QUOTE find)
CurSlot
(QUOTE of]
ThenCompute [LAMBDA (task)
[SETQ SlotsToChange (RandomSubset (SetIntersect
(SlotNames CurUnit)
(Examples (QUOTE Slot]
(SETQ CreditTo (CDR (ASSOC (QUOTE CreditTo)
CurSup)))
T]
ThenComputeRecord (430 . 4)
ThenAddToAgendaRecord (688 . 4)
ThenPrintToUserRecord (435 . 4)
OverallRecord (1943 . 4)
Arity 1)
(PUTPROPS H18 IsA (Heuristic Anything Op)
English (IF the current task is to generalize a unit, and a slot has been chosen to
be the one changed, THEN randomly select a part of it and generalize that
part)
IfPotentiallyRelevant NULL
Worth 704
Abbrev (Generalize a given slot of a given unit)
IfWorkingOnTask [LAMBDA (task)
(AND (IsAKindOf CurSlot (QUOTE Generalizations))
(SETQ SlotToChange (CADR (ASSOC (QUOTE SlotToChange)
CurSup]
ThenPrintToUser [LAMBDA (task)
(CPRIN1 13 CRLF "Generalized the " SlotToChange " slot of "
CurUnit ", replacing its old value ")
(CPRIN1 48 "(which was " OldValue ") ")
(CPRIN1 14 "by " NewValue "." CRLF)
(CPRIN1 13 CRLF)
T]
ThenCompute [LAMBDA
(task)
(* assumes the existence of functions GeneralizeLispPred
GeneralizeLispFn GeneralizeList and of course GeneralizeNIL to catch
the slots which have not DataType slot)
(SETQ UDiff NIL)
(SETQ AreUnits NIL)
(SETQ HaveGenl NIL)
[SETQ NewValue (APPLY* (PACK* (QUOTE Generalize)
(DataType SlotToChange))
(SETQ OldValue (APPLY* SlotToChange CurUnit]
(SETQ NeedGenl (SetDiff AreUnits HaveGenl))
(* If the OldValue and NewValue are equal, then we really haven't
generalized it at all, so we want to return NIL and have this rule
FAIL)
(MAPC HaveGenl (QUOTE TinyReward))
[AND HaveGenl
(SETQ TaskResults
(AddPropL TaskResults (QUOTE RewardedUnits)
(CONS HaveGenl
(APPEND (QUOTE (because they could have been
used in generalizing)
)
(LIST CurUnit]
(SETQ
Agenda
(MergeTasks
[MAPCAR NeedGenl
(FUNCTION
(LAMBDA (ns)
(LIST (Half CurPri)
ns
(QUOTE Generalizations)
[LIST (CONS CurUnit
(APPEND (QUOTE (might have been
generalized
better,
earlier, if
some
generalizations had
existed for)
)
(LIST ns]
(LIST (LIST (QUOTE CreditTo)
(QUOTE H18]
Agenda))
[AND NeedGenl
(SETQ TaskResults
(AddPropL TaskResults (QUOTE NewTasks)
(CONS NeedGenl
(APPEND (QUOTE (will be generalized, because
if such generalizations
had existed, we could
have used them just now
while trying to
generalize))
(LIST CurUnit]
(COND ((EQUAL OldValue NewValue)
(CPRIN1 15 CRLF
"Hmmm... couldn't seem to find any meaningful generalization of the "
SlotToChange " slot of " CurUnit CRLF)
NIL)
((IGREATERP Verbosity 15)
(CPRIN1 15 CRLF "Inside the " SlotToChange " slot, ")
(MAPRINT UDiff)
(TERPRI)
T)
(T T]
ThenDefineNewConcepts [LAMBDA (task)
(SETQ NewUnit (CreateUnit CurUnit CurUnit))
[MAPC (SibSlots SlotToChange)
(FUNCTION (LAMBDA (S)
(KillSlot NewUnit S]
(PUT NewUnit SlotToChange NewValue)
(SETQ NewUnits (CDR (ASSOC (QUOTE NewUnits)
TaskResults)))
[COND (NewUnits (NCONC1 NewUnit NewUnits))
(T (SETQ TaskResults (CONS (LIST (QUOTE NewUnits)
NewUnit)
TaskResults]
(ADDPROP (QUOTE H18)
(QUOTE Applics)
(LIST (LIST (QUOTE TaskNum:)
TaskNum task (DATE))
(LIST NewUnit)
(InitializeCreditAssignment)
(LIST (QUOTE Generalized)
SlotToChange
(QUOTE slot)
(QUOTE of)
CurUnit
(QUOTE as)
(QUOTE follows:)
UDiff)))
[MAPC (SETQ Creditors (CDR (ASSOC (QUOTE CreditTo)
CurSup)))
(FUNCTION (LAMBDA
(H)
(ADDPROP H (QUOTE Applics)
(LIST (LIST (QUOTE TaskNum:)
TaskNum task
(DATE))
(LIST NewUnit)
(
DecrementCreditAssignment]
(PUT NewUnit (QUOTE Creditors)
(SETQ Creditors (CONS (QUOTE H18)
Creditors)))
(ADDPROP CurUnit (QUOTE Generalizations)
NewUnit)
(ADDPROP NewUnit (QUOTE Specializations)
CurUnit)
T]
ThenComputeFailedRecord (5658 . 17)
ThenComputeRecord (3974 . 13)
ThenDefineNewConceptsRecord (5740 . 13)
ThenPrintToUserRecord (2147 . 13)
OverallRecord (13078 . 13)
Arity 1)
(PUTPROPS H19 IsA (Heuristic Op Anything)
English (IF we just created some new units, THEN eliminate any whose slots are
equivalent to already-extant units)
IfPotentiallyRelevant NULL
Worth 150
Abbrev (Kill any new unit that's the same as an existing one)
IfFinishedWorkingOnTask [LAMBDA
(task)
(AND
NewUnits
(ASSOC (QUOTE NewUnits)
TaskResults)
(SETQ
DoomedU
(SUBSET
NewUnits
(FUNCTION
(LAMBDA
(U)
(SOME (DREMOVE U (MapUnion (IsA U)
(QUOTE Examples)))
(FUNCTION
(LAMBDA
(Z)
(* See if U and Z are equivalent units)
(EVERY (INTERSECTION
(PROPNAMES U)
(Examples (QUOTE Slot)))
(FUNCTION (LAMBDA
(P)
(EqualToWithinSubst
U Z
(APPLY* P U)
(APPLY* P Z]
ThenPrintToUser [LAMBDA (C)
(CPRIN1 14 CRLF "Hmf! " (LENGTH DoomedU)
" of the "
(LENGTH NewUnits)
" new units "
(CONS (QUOTE namely:)
DoomedU)
" seem indistinguishable from pre-existing units!"
" They must be destroyed..."
CRLF)
(SETQ NewUnits (SetDiff NewUnits DoomedU))
T]
ThenDeleteOldConcepts [LAMBDA (C)
(MAPC DoomedU (QUOTE KillUnit))
T]
Applics (((sit1)
(win1 los1))
((sit2)
(los2 los3 los4 los5 los6)))
SubsumedBy (H19Criterial)
Arity 1)
(PUTPROPS H19Criterial IsA (Heuristic Op Anything)
English (IF we just created some new units, THEN eliminate any whose
criterial slots are equivalent to already-extant units)
IfPotentiallyRelevant NULL
Worth 700
Abbrev (Kill any new unit which duplicates an already-existing one)
IfFinishedWorkingOnTask [LAMBDA
(task)
(AND
NewUnits
(ASSOC (QUOTE NewUnits)
TaskResults)
(SETQ
DoomedU
(SUBSET
NewUnits
(FUNCTION
(LAMBDA
(U)
(SOME
[UNION (CONS CurUnit
(GETPROP CurUnit
(QUOTE
Specializations)))
(DREMOVE U (MapUnion
(IsA U)
(QUOTE Examples]
(FUNCTION
(LAMBDA
(Z)
(* See if U and Z are equivalent
units)
(EVERY (INTERSECTION
(PROPNAMES U)
(Examples (QUOTE
CriterialSlot)))
(FUNCTION
(LAMBDA
(P)
(EqualToWithinSubst
U Z (APPLY* P U)
(APPLY* P Z]
ThenPrintToUser [LAMBDA (C)
(CPRIN1 14 CRLF "Hmf! " (LENGTH DoomedU)
" of the "
(LENGTH NewUnits)
" new units "
(CONS (QUOTE namely:)
DoomedU)
" have criterial slots that"
" seem indistinguishable from pre-existing units!"
" They must be destroyed..." CRLF)
(SETQ NewUnits (SetDiff NewUnits DoomedU))
T]
ThenDeleteOldConcepts [LAMBDA (C)
(MAPC DoomedU (QUOTE KillUnit))
T]
Subsumes (H19)
Creditors (H6 H5 H1)
ThenDeleteOldConceptsRecord (45416 . 52)
ThenPrintToUserRecord (10904 . 52)
OverallRecord (69884 . 52)
Arity 1)
(PUTPROPS H2 IsA (Heuristic Op Anything)
English (IF you have just finished a task, and some units were created, and one of the
creators has the property of spewing garbage, THEN snuff that spewer)
IfPotentiallyRelevant NULL
Worth 700
Abbrev (Kill a concept that leads to lots of garbage)
IfFinishedWorkingOnTask [LAMBDA
(task)
(AND
(ASSOC (QUOTE NewUnits)
TaskResults)
(SETQ
PosCred
(SUBSET
(SelfIntersect (MapUnion (CDR (ASSOC (QUOTE NewUnits)
TaskResults))
(FUNCTION Creditors)))
(FUNCTION
(LAMBDA
(C)
(* See if C has generated many concepts none of
which have any decent applics)
(AND
(MEMB C NewU)
(IGEQ (LENGTH (Applics C))
10)
(EVERY
(Applics C)
(FUNCTION
(LAMBDA
(Z)
(AND (LISTP (CADR Z))
(EVERY (CADR Z)
(FUNCTION
(LAMBDA (A)
(NULL (Applics
A]
ThenPrintToUser [LAMBDA (task)
(CPRIN1 14 CRLF CRLF (LENGTH PosCred)
" units were reduced in Worth, due to excessive generation of mediocre concepts by them; namely: "
PosCred CRLF)
(AND DeletedUnits (CPRIN1 14 CRLF CRLF (LENGTH DeletedUnits)
" had Worths that were now so low, the whole concept was obliterated;"
" namely; " DeletedUnits CRLF CRLF))
(SETQ PosCred NIL)
(SETQ DeletedUnits NIL)
T]
ThenCompute [LAMBDA (task)
(AND (BOUNDP (QUOTE PosCred))
(LISTP PosCred)
(OR (MAPC PosCred (QUOTE PunishSeverely))
T)
(SETQ TaskResults
(AddPropL TaskResults (QUOTE PunishedUnits)
(CONS PosCred
(QUOTE (because they've led to so many
questionable units
being created!]
ThenDeleteOldConcepts [LAMBDA (task)
(SETQ DeletedUnits NIL)
[MAPC PosCred (FUNCTION
(LAMBDA (C)
(COND ((ILEQ (Worth C)
175)
(SETQ DeletedUnits
(CONS C DeletedUnits))
[MAPC (Examples (QUOTE
HindSightRule))
(FUNCTION (LAMBDA
(r)
(ApplyRule
r C
", before we delete it."]
(KillUnit C]
[AND DeletedUnits
(SETQ TaskResults
(AddPropL TaskResults (QUOTE DeletedUnits)
(CONS DeletedUnits
(QUOTE (because their Worth
has fallen so
low]
T]
Arity 1)
(PUTPROPS H20 IsA (Heuristic Op Anything)
English (IF an op f (e.g., a math function, a heuristic, a slot)
can apply to any of the domain items of another op, THEN so apply it and
maybe some patterns will emerge)
IfPotentiallyRelevant [LAMBDA (f)
(* check that f has some recorded applications -- which
implies, of course, that f is an
executable/performable entity)
(SETQ AlgToUse (Alg f]
IfTrulyRelevant [LAMBDA (f)
(* check that some Applics of f have high Worth, but most
have low Worth)
(* the extent to which those conditions are met will
determine the amount of energy to expend working on
applying this rule -- its overall relevancy)
(AND (NOT (SubsumedBy f))
[SETQ SpaceToUse
(SUBSET (REMOVE f (Sibs f))
(FUNCTION
(LAMBDA
(f2)
(AND (EQ (Arity f)
(Arity f2))
(IGREATERP (LENGTH (Applics
f2))
3]
(SETQ DomainTests (MAPCAR (Domain f)
(QUOTE Defn]
Worth 600
Abbrev (Run f on args used for other ops)
ThenPrintToUser [LAMBDA (f)
(CPRIN1 14 CRLF f
"'s algorithm has been run on new data upon which these have already been run: "
AddedSome CRLF
" We will sometime look for connections between "
f " and each of those other operations." CRLF)
T]
ThenAddToAgenda [LAMBDA (f)
(SETQ Agenda
(MergeTasks
[MAPCAR AddedSome
(FUNCTION
(LAMBDA (f2)
(LIST (AverageWorths
f2
(AverageWorths
f
(QUOTE H20)))
f
(QUOTE Conjectures)
(LIST (LIST f (QUOTE has)
(QUOTE now)
(QUOTE been)
(QUOTE run)
(QUOTE on)
(QUOTE the)
(QUOTE same)
(QUOTE data)
(QUOTE as)
f2
(QUOTE ,)
(QUOTE and)
(QUOTE we)
(QUOTE should)
(QUOTE
investigate)
(QUOTE any)
(QUOTE patterns)
(QUOTE connecting)
(QUOTE them)))
(LIST (LIST (QUOTE CreditTo)
(QUOTE H20))
(LIST (QUOTE
InvolvedUnits)
(LIST f2]
Agenda))
(AddPropL TaskResults (QUOTE NewTasks)
(CONS (LENGTH AddedSome)
(QUOTE (units may have connections to current
one]
ThenCompute [LAMBDA (f)
(SETQ AddedSome NIL)
[MAPC SpaceToUse
(FUNCTION
(LAMBDA
(f2)
(MAPC (Applics f2)
(FUNCTION
(LAMBDA
(ap)
(AND (NOT (KnownApplic f (CAR ap)))
(EVERY2 DomainTests (CAR ap)
(QUOTE APPLY*))
[UnionProp f (QUOTE Applics)
(LIST (CAR ap)
(APPLY AlgToUse
(CAR ap]
(NOT (MEMB f2 AddedSome))
(SETQ AddedSome (CONS f2 AddedSome]
AddedSome]
Arity 1
ThenComputeFailedRecord (5828 . 14)
ThenComputeRecord (-546691 . 16)
ThenAddToAgendaRecord (4718 . 16)
ThenPrintToUserRecord (5335 . 16)
OverallRecord (-528368 . 16))
(PUTPROPS H21 IsA (Heuristic Op Anything)
English (IF an op u duplicates all the results of u2, THEN conjecture that u is an
extension of u2)
IfPotentiallyRelevant NULL
Worth 400
Abbrev (See if u is an extension of u2)
IfWorkingOnTask [LAMBDA (task)
(AND (IsAKindOf CurSlot (QUOTE Conjectures))
(SETQ InvolvedUnits (CADR (ASSOC (QUOTE InvolvedUnits)
CurSup]
ThenPrintToUser [LAMBDA (task)
(CPRIN1 13 CRLF "Apparently " CurUnit " is an extension of "
ResU CRLF)
T]
ThenConjecture [LAMBDA
(task)
[MAPC
ResU
(FUNCTION
(LAMBDA
(u2)
(SETQ
Conjectures
(CONS
(PROGN
(SETQ conjec (NewNam (QUOTE Conjec)))
(CreateUnit conjec (QUOTE ProtoConjec))
(PUT conjec (QUOTE English)
(LIST (QUOTE All)
(QUOTE applics)
(QUOTE of)
u2
(QUOTE are)
(QUOTE also)
(QUOTE applics)
(QUOTE of)
CurUnit
(QUOTE ,)
(QUOTE so)
(QUOTE we)
(QUOTE presume)
(QUOTE that)
CurUnit
(QUOTE is)
(QUOTE an)
(QUOTE extension)
(QUOTE of)
u2))
(PUT conjec (QUOTE Abbrev)
(LIST CurUnit (QUOTE appears)
(QUOTE to)
(QUOTE be)
(QUOTE an)
(QUOTE extension)
(QUOTE of)
u2))
[PUT
conjec
(QUOTE Worth)
(FIX
(Average
(AverageWorths (QUOTE H21)
(AverageWorths CurUnit u2))
(MIN 1000
(FIX (TIMES 100.0 (LOG (LENGTH (Applics
u2]
(PUT conjec (QUOTE ConjectureAbout)
(LIST CurUnit u2))
conjec)
Conjectures))
(UnionProp u2 (QUOTE Conjectures)
conjec)
(UnionProp CurUnit (QUOTE Conjectures)
conjec)
(UnionProp CurUnit (QUOTE Restrictions)
u2)
(UnionProp u2 (QUOTE Extensions)
CurUnit]
ResU]
ThenCompute [LAMBDA (task)
(SETQ ResU (SUBSET InvolvedUnits (FUNCTION
(LAMBDA (u2)
(AND (Applics u2)
(IsSubsetOf (Applics u2)
(Applics CurUnit]
Arity 1
ThenComputeFailedRecord (805 . 18)
ThenComputeRecord (3584 . 2)
ThenConjectureRecord (3055 . 2)
ThenPrintToUserRecord (287 . 2)
OverallRecord (11576 . 2))
(PUTPROPS H3 IsA (Heuristic Op Anything)
English (IF the current task is to specialize a unit, but no specific slot to
specialize is yet known, THEN choose one)
IfPotentiallyRelevant NULL
Worth 101
Applics (((sit1)
(win1 los1)))
Abbrev (Randomly choose a slot to specialize)
IfWorkingOnTask [LAMBDA (task)
(AND (IsAKindOf CurSlot (QUOTE Specializations))
(NULL (ASSOC (QUOTE SlotToChange)
CurSup))
(IGEQ 11 (TheNumberOf Agenda
(FUNCTION
(LAMBDA
(Z)
(AND (EQ CurUnit (
ExtractUnitName
Z))
(EQ CurSlot (
ExtractSlotName
Z]
ThenPrintToUser [LAMBDA (task)
(CPRIN1 13 CRLF NewReason CRLF CRLF)
T]
ThenAddToAgenda [LAMBDA (task)
(SETQ Agenda
(MergeTasks
[LIST (LIST (Average CurPri (AverageWorths
CurUnit
(QUOTE H3)))
CurUnit CurSlot
(CONS (SETQ NewReason
(LIST
"A new unit will be created by specializing the "
SlotToChange " slot of "
CurUnit
"; that slot was chosen randomly."))
NIL)
(LIST (LIST (QUOTE SlotToChange)
SlotToChange)
(CONS (QUOTE CreditTo)
(CONS (QUOTE H3)
CreditTo]
Agenda))
(SETQ TaskResults (AddPropL TaskResults (QUOTE NewTasks)
(LIST 1 (QUOTE specific)
(QUOTE slot)
(QUOTE of)
CurUnit
(QUOTE to)
(QUOTE find)
CurSlot
(QUOTE of]
ThenCompute [LAMBDA (task)
[SETQ SlotToChange (RandomChoose (SetIntersect
(SlotNames CurUnit)
(Examples (QUOTE Slot]
(SETQ CreditTo (CDR (ASSOC (QUOTE CreditTo)
CurSup)))
T]
SubsumedBy (H5 H5Criterial H5Good)
Arity 1)
(PUTPROPS H4 IsA (Heuristic Op Anything)
English (IF a new unit has been synthesized, THEN place a task on the Agenda to gather
new empirical data about it)
IfPotentiallyRelevant NULL
Worth 703
Applics (((sit1)
(win1 los1)))
Abbrev (about concepts Gather data new empirical)
IfFinishedWorkingOnTask [LAMBDA (task)
(SETQ NewUnits (SUBSET (CDR (ASSOC (QUOTE NewUnits)
TaskResults))
(QUOTE Unitp]
ThenPrintToUser [LAMBDA (task)
(CPRIN1 13 CRLF (LENGTH NewUnits)
" new units ")
(CPRIN1 33 ", namely " NewUnits ", ")
(CPRIN1 13
"were defined. New tasks are being added to the agenda to ensure that empirical data about them will soon be gathered. "
CRLF CRLF)
T]
ThenAddToAgenda [LAMBDA (task)
(SETQ Agenda
(MergeTasks
[MAPCAR NewUnits
(FUNCTION (LAMBDA
(NewUnit)
(LIST (AverageWorths NewUnit
(QUOTE H4))
NewUnit
(Instances NewUnit)
(LIST
"After a unit is synthesized, it is useful to seek instances of it.")
(LIST (LIST (QUOTE CreditTo)
(QUOTE H4]
Agenda))
(SETQ TaskResults
(AddPropL TaskResults (QUOTE NewTasks)
(CONS (LENGTH NewUnits)
(QUOTE (new units must have instances
found]
ThenAddToAgendaRecord (30653 . 87)
ThenPrintToUserRecord (18543 . 87)
OverallRecord (68827 . 72)
Arity 1)
(PUTPROPS H5 IsA (Heuristic Op Anything)
English (IF the current task is to specialize a unit, and no specific slot has been
chosen to be the one changed, THEN randomly select which slots to
specialize)
IfPotentiallyRelevant NULL
Worth 151
Applics (((sit1)
(win1 los1))
((TaskNum: 244)
(H19Criterial)
2)
((TaskNum: 23)
(H5Criterial)
2)
((TaskNum: 23)
(H5Good)
2))
Abbrev (Choose some particular slots of u to specialize)
IfWorkingOnTask [LAMBDA (task)
(AND (IsAKindOf CurSlot (QUOTE Specializations))
(NULL (ASSOC (QUOTE SlotToChange)
CurSup))
(IGEQ 7 (TheNumberOf Agenda
(FUNCTION
(LAMBDA
(Z)
(AND (EQ CurUnit (
ExtractUnitName
Z))
(EQ CurSlot (
ExtractSlotName
Z]
ThenPrintToUser [LAMBDA (task)
(CPRIN1 13 CRLF CurUnit
" will be specialized by specializing the following of its slots: "
SlotsToChange CRLF CRLF)
T]
ThenAddToAgenda [LAMBDA
(task)
(SETQ
Agenda
(MergeTasks
(SORT [MAPCAR SlotsToChange
(FUNCTION
(LAMBDA
(S)
(LIST (Average CurPri (AverageWorths
S
(QUOTE H5)))
CurUnit CurSlot
(CONS (SETQ NewReason
(LIST
"A new unit will be created by specializing the "
S " slot of " CurUnit
"; that slot was chosen randomly."))
NIL)
(LIST (LIST (QUOTE SlotToChange)
S)
(CONS (QUOTE CreditTo)
(CONS (QUOTE H5)
CreditTo]
(QUOTE OrderTasks))
Agenda))
(SETQ TaskResults (AddPropL TaskResults (QUOTE NewTasks)
(LIST (LENGTH SlotsToChange)
(QUOTE specific)
(QUOTE slots)
(QUOTE of)
CurUnit
(QUOTE to)
(QUOTE find)
CurSlot
(QUOTE of]
ThenCompute [LAMBDA (task)
[SETQ SlotsToChange (RandomSubset (SetIntersect
(SlotNames CurUnit)
(Examples (QUOTE Slot]
(SETQ CreditTo (CDR (ASSOC (QUOTE CreditTo)
CurSup)))
T]
Subsumes (H3)
SubsumedBy (H5Criterial H5Good)
Arity 1)
(PUTPROPS H5Criterial IsA (Heuristic Op Anything)
English (IF the current task is to specialize a unit, and no specific slot
has been chosen to be the one changed, THEN randomly select which
criterial slots to specialize)
IfPotentiallyRelevant NULL
Worth 700
Abbrev (Choose some particular criterial slots of u to specialize)
IfWorkingOnTask [LAMBDA (task)
(AND (IsAKindOf CurSlot (QUOTE Specializations))
(NULL (ASSOC (QUOTE SlotToChange)
CurSup))
(IGEQ 7 (TheNumberOf
Agenda
(FUNCTION (LAMBDA
(Z)
(AND (EQ CurUnit
(ExtractUnitName
Z))
(EQ CurSlot
(ExtractSlotName
Z]
ThenPrintToUser [LAMBDA (task)
(CPRIN1 13 CRLF CurUnit
" will be specialized by specializing the following of its criterial slots: "
SlotsToChange CRLF CRLF)
T]
ThenAddToAgenda [LAMBDA
(task)
(SETQ
Agenda
(MergeTasks
(SORT
[MAPCAR SlotsToChange
(FUNCTION
(LAMBDA
(S)
(LIST (Average CurPri
(AverageWorths
S
(QUOTE H5Criterial)))
CurUnit CurSlot
(CONS (SETQ NewReason
(LIST
"A new unit will be created by specializing the "
S " slot of "
CurUnit
"; that criterial slot was chosen randomly."))
NIL)
(LIST (LIST (QUOTE SlotToChange)
S)
(CONS (QUOTE CreditTo)
(CONS (QUOTE
H5Criterial)
CreditTo]
(QUOTE OrderTasks))
Agenda))
(SETQ TaskResults (AddPropL TaskResults (QUOTE NewTasks)
(LIST (LENGTH SlotsToChange)
(QUOTE specific)
(QUOTE criterial)
(QUOTE slots)
(QUOTE of)
CurUnit
(QUOTE to)
(QUOTE find)
CurSlot
(QUOTE of]
ThenCompute [LAMBDA (task)
[SETQ SlotsToChange (RandomSubset
(SetIntersect (SlotNames CurUnit)
(Examples (QUOTE CriterialSlot]
(SETQ CreditTo (CDR (ASSOC (QUOTE CreditTo)
CurSup)))
T]
Subsumes (H3 H5)
Creditors (H6 H5 H1)
ThenComputeRecord (3850 . 46)
ThenAddToAgendaRecord (12150 . 46)
ThenPrintToUserRecord (7532 . 46)
OverallRecord (37450 . 46)
Arity 1)
(PUTPROPS H5Good IsA (Heuristic Op Anything)
English (IF the current task is to specialize a unit, and no specific slot has
been chosen to be the one changed, THEN choose a good set of slots to
specialize)
IfPotentiallyRelevant NULL
Worth 700
Abbrev (Choose some particular good slots of u to specialize)
IfWorkingOnTask [LAMBDA (task)
(AND (IsAKindOf CurSlot (QUOTE Specializations))
(NULL (ASSOC (QUOTE SlotToChange)
CurSup))
(IGEQ 7 (TheNumberOf Agenda
(FUNCTION
(LAMBDA
(Z)
(AND (EQ CurUnit
(ExtractUnitName
Z))
(EQ CurSlot
(ExtractSlotName
Z]
ThenPrintToUser [LAMBDA (task)
(CPRIN1 13 CRLF CurUnit
" will be specialized by specializing the following of its good slots: "
SlotsToChange CRLF CRLF)
T]
ThenAddToAgenda [LAMBDA
(task)
(SETQ
Agenda
(MergeTasks
(SORT [MAPCAR SlotsToChange
(FUNCTION
(LAMBDA
(S)
(LIST (Average CurPri (AverageWorths
S
(QUOTE H5Good)))
CurUnit CurSlot
(CONS (SETQ NewReason
(LIST
"A new unit will be created by specializing the "
S " slot of "
CurUnit
"; that slot was chosen because of its high worth."))
NIL)
(LIST (LIST (QUOTE SlotToChange)
S)
(CONS (QUOTE CreditTo)
(CONS (QUOTE H5Good)
CreditTo]
(QUOTE OrderTasks))
Agenda))
(SETQ TaskResults (AddPropL TaskResults (QUOTE NewTasks)
(LIST (LENGTH SlotsToChange)
(QUOTE specific)
(QUOTE good)
(QUOTE slots)
(QUOTE of)
CurUnit
(QUOTE to)
(QUOTE find)
CurSlot
(QUOTE of]
ThenCompute [LAMBDA (task)
[SETQ SlotsToChange (GoodSubset (SetIntersect
(SlotNames CurUnit)
(Examples (QUOTE Slot]
(SETQ CreditTo (CDR (ASSOC (QUOTE CreditTo)
CurSup)))
T]
Subsumes (H3 H5)
Creditors (H6 H5 H1)
ThenComputeRecord (10632 . 46)
ThenAddToAgendaRecord (23977 . 46)
ThenPrintToUserRecord (8399 . 46)
OverallRecord (56898 . 46)
Arity 1)
(PUTPROPS H6 IsA (Heuristic Op Anything)
English (IF the current task is to specialize a unit, and a slot has been chosen to be
the one changed, THEN randomly select a part of it and specialize that
part)
IfPotentiallyRelevant NULL
Worth 700
Abbrev (Specialize a given slot of a given unit)
IfWorkingOnTask [LAMBDA (task)
(AND (IsAKindOf CurSlot (QUOTE Specializations))
(SETQ SlotToChange (CADR (ASSOC (QUOTE SlotToChange)
CurSup]
ThenPrintToUser [LAMBDA (task)
(CPRIN1 13 CRLF "Specialized the " SlotToChange " slot of "
CurUnit ", replacing its old value ")
(CPRIN1 48 "(which was " OldValue ") ")
(CPRIN1 14 "by " NewValue "." CRLF)
(CPRIN1 13 CRLF)
T]
ThenCompute [LAMBDA
(task)
(* assumes the existence of functions SpecializeLispPred
SpecializeLispFn SpecializeList and of course SpecializeNIL to catch
the slots which have not DataType slot)
(SETQ UDiff NIL)
(SETQ AreUnits NIL)
(SETQ HaveSpec NIL)
[SETQ NewValue (APPLY* (PACK* (QUOTE Specialize)
(DataType SlotToChange))
(SETQ OldValue (APPLY* SlotToChange CurUnit]
(SETQ NeedSpec (SetDiff AreUnits HaveSpec))
(* If the OldValue and NewValue are equal, then we really haven't
specialized it at all, so we want to return NIL and have this rule
FAIL)
(MAPC HaveSpec (QUOTE TinyReward))
[AND HaveSpec
(SETQ TaskResults
(AddPropL TaskResults (QUOTE RewardedUnits)
(CONS HaveSpec
(APPEND (QUOTE (because they could have been
used in specializing))
(LIST CurUnit]
(SETQ Agenda
(MergeTasks
[MAPCAR NeedSpec
(FUNCTION
(LAMBDA
(ns)
(LIST (Half CurPri)
ns
(QUOTE Specializations)
[LIST (CONS CurUnit
(APPEND (QUOTE (might have been
specialized
better,
earlier, if
some
specializations had
existed for))
(LIST ns]
(LIST (LIST (QUOTE CreditTo)
(QUOTE H6]
Agenda))
[AND NeedSpec
(SETQ TaskResults
(AddPropL TaskResults (QUOTE NewTasks)
(CONS NeedSpec
(APPEND (QUOTE (will be specialized, because
if such specializations
had existed, we could
have used them just now
while trying to
specialize))
(LIST CurUnit]
(COND ((EQUAL OldValue NewValue)
(CPRIN1 15 CRLF
"Hmmm... couldn't seem to find any meaningful specialization of the "
SlotToChange " slot of " CurUnit CRLF)
NIL)
((IGREATERP Verbosity 15)
(CPRIN1 15 CRLF "Inside the " SlotToChange " slot, ")
(MAPRINT UDiff)
(TERPRI)
T)
(T T]
ThenDefineNewConcepts [LAMBDA (task)
(SETQ NewUnit (CreateUnit CurUnit CurUnit))
[MAPC (SibSlots SlotToChange)
(FUNCTION (LAMBDA (S)
(KillSlot NewUnit S]
(PUT NewUnit SlotToChange NewValue)
(SETQ NewUnits (CDR (ASSOC (QUOTE NewUnits)
TaskResults)))
[COND (NewUnits (NCONC1 NewUnit NewUnits))
(T (SETQ TaskResults (CONS (LIST (QUOTE NewUnits)
NewUnit)
TaskResults]
(ADDPROP (QUOTE H6)
(QUOTE Applics)
(LIST (LIST (QUOTE TaskNum:)
TaskNum task (DATE))
(LIST NewUnit)
(InitializeCreditAssignment)
(LIST (QUOTE Specialized)
SlotToChange
(QUOTE slot)
(QUOTE of)
CurUnit
(QUOTE as)
(QUOTE follows:)
UDiff)))
[MAPC (SETQ Creditors (CDR (ASSOC (QUOTE CreditTo)
CurSup)))
(FUNCTION (LAMBDA
(H)
(ADDPROP H (QUOTE Applics)
(LIST (LIST (QUOTE TaskNum:)
TaskNum)
(LIST NewUnit)
(
DecrementCreditAssignment]
(PUT NewUnit (QUOTE Creditors)
(SETQ Creditors (CONS (QUOTE H6)
Creditors)))
(ADDPROP CurUnit (QUOTE Specializations)
NewUnit)
(ADDPROP NewUnit (QUOTE Generalizations)
CurUnit)
T]
Applics [((TaskNum: 244 (H19 Specializations ((SlotToChange IfFinishedWorkingOnTask)))
"29-Mar-81 17:28:41")
(H19Criterial)
1
(Specialized IfFinishedWorkingOnTask slot of H19 as follows:
(Slot -> CriterialSlot)))
((TaskNum: 23 (H5 Specializations ((SlotToChange ThenCompute)))
"29-Mar-81 16:28:41")
(H5Criterial)
1
(Specialized ThenCompute slot of H5 as follows: (Slot -> CriterialSlot)))
((TaskNum: 23 (H5 Specializations ((SlotToChange ThenCompute)))
"29-Mar-81 16:28:55")
(H5Good)
1
(Specialized ThenCompute slot of H5 as follows: (RandomSubset -> GoodSubset]
ThenComputeRecord (58183 . 73)
ThenDefineNewConceptsRecord (74674 . 73)
ThenPrintToUserRecord (31470 . 73)
OverallRecord (188387 . 73)
ThenComputeFailedRecord (24908 . 56)
Arity 1)
(PUTPROPS H7 IsA (Heuristic Op Anything)
English (IF a concept has no known instances, THEN try to find some)
IfPotentiallyRelevant [LAMBDA (f)
(* check that f has some recorded applications -- which
implies, of course, that f is an
executable/performable entity)
(NULL (APPLY* (Instances f)
f]
IfTrulyRelevant [LAMBDA (f)
(OR (MEMB (QUOTE Category)
(IsA f))
(MEMB (QUOTE Op)
(IsA f]
Worth 700
Abbrev (Instantiate a concept having no known instances)
ThenPrintToUser [LAMBDA (f)
(CPRIN1 13 CRLF "Since " f " has no known " (Instances f)
", it is probably worth looking for some." CRLF)
T]
ThenAddToAgenda [LAMBDA (f)
(SETQ Agenda
(MergeTasks
[LIST (LIST (AverageWorths f (QUOTE H7))
f
(Instances f)
[LIST (SUBST f (QUOTE f)
(QUOTE (To properly study f
we must gather
empirical data
about instances of
that concept]
(LIST (LIST (QUOTE CreditTo)
(QUOTE H7]
Agenda))
(AddPropL TaskResults (QUOTE NewTasks)
(QUOTE (1 unit must be instantiated]
ThenAddToAgendaRecord (11017 . 172)
ThenPrintToUserRecord (21543 . 172)
OverallRecord (71147 . 172)
Arity 1)
(PUTPROPS H8 IsA (Heuristic Op Anything)
English (IF the current task is to find application-instances of a unit, and it has a
algorithm, THEN look over instances of generalizations of the unit, and
see if any of them are valid application-instances of this as well)
IfPotentiallyRelevant NULL
Worth 700
Abbrev (Applics (u)
may be found amongst Applics (Genl (u)))
IfWorkingOnTask [LAMBDA
(task)
(AND (EQ CurSlot (QUOTE Applics))
(SETQ AlgToUse (Alg CurUnit))
(SETQ SpaceToUse
(SUBSET (SetDiff
(SUBSET [OR (Generalizations CurUnit)
(SelfIntersect (MAPAPPEND
(IsA CurUnit)
(QUOTE Examples]
(QUOTE Applics))
(CONS CurUnit (Specializations CurUnit)))
(FUNCTION (LAMBDA (F)
(EQ (Arity F)
(Arity CurUnit]
ThenPrintToUser [LAMBDA (task)
(CPRIN1 13 CRLF "Instantiated " CurUnit "; found "
(LENGTH NewValues)
" "
(QUOTE Applics)
CRLF)
(CPRIN1 48 " Namely: " NewValues CRLF)
T]
ThenCompute [LAMBDA (task DomainTests)
[* (PUTD (QUOTE APPLYTOUSE)
(GETD (COND ((AND (Arity CurUnit)
(IGREATERP (Arity CurUnit)
1))
(QUOTE APPLY))
(T (QUOTE APPLY*]
(SETQ CurVal (APPLY* CurSlot CurUnit))
(SETQ DomainTests (MAPCAR (Domain CurUnit)
(QUOTE Defn)))
[MAPC SpaceToUse
(FUNCTION
(LAMBDA
(Z)
(MapApplics
Z
[FUNCTION
(LAMBDA (I TEMP)
(AND (NOT (KnownApplic CurUnit (ApplicArgs
I)))
(EQUAL (LENGTH DomainTests)
(ApplicArgs I))
(for DT in DomainTests as A in
(ApplicArgs I)
always
(APPLY* DT A))
(SETQ
TEMP
(ERRORSET (QUOTE (APPLY AlgToUse
(ApplicArgs
I)))
(QUOTE NOBREAK)))
(UnionProp CurUnit (QUOTE Applics)
(LIST (ApplicArgs I)
(CAR TEMP]
100]
(AND (SETQ NewValues (SetDifference (Applics CurUnit)
CurVal))
(SETQ TaskResults (CONS (LIST (QUOTE NewValues)
(LIST CurUnit CurSlot NewValues
(LIST (QUOTE By)
(QUOTE examining)
(QUOTE Applics)
(QUOTE of)
SpaceToUse
(QUOTE ,)
(QUOTE Eurisko)
(QUOTE found)
(LENGTH NewValues)
(QUOTE of)
(QUOTE them)
(QUOTE were)
(QUOTE also)
(QUOTE Applics)
(QUOTE of)
CurUnit)))
TaskResults]
ThenComputeFailedRecord (635979 . 66)
ThenComputeRecord (368382 . 10)
ThenPrintToUserRecord (3893 . 10)
OverallRecord (375388 . 10)
Arity 1)
(PUTPROPS H9 IsA (Heuristic Op Anything)
English (IF the current task is to find examples of a unit, and it has a definition,
THEN look over instances of generalizations of the unit, and see if any of
them are valid examples of this as well)
IfPotentiallyRelevant NULL
Worth 700
Abbrev (Exs (u)
may be found amongst Exs (Genl (u)))
IfWorkingOnTask [LAMBDA (task)
(AND (EQ CurSlot (QUOTE Examples))
(SETQ DefnToUse (Defn CurUnit))
(SETQ SpaceToUse
(SetDiff [OR (Generalizations CurUnit)
(SelfIntersect (MAPAPPEND
(IsA CurUnit)
(QUOTE Examples]
(CONS CurUnit (Specializations CurUnit]
ThenPrintToUser [LAMBDA (task)
(CPRIN1 13 CRLF "Instantiated " CurUnit "; found "
(LENGTH NewValues)
" "
(QUOTE Examples)
CRLF)
(CPRIN1 48 " Namely: " NewValues CRLF)
T]
ThenCompute [LAMBDA (task)
(SETQ CurVal (APPLY* CurSlot CurUnit))
[RESETVAR
UserImpatience
[MAX 1 (IQUOTIENT UserImpatience (MAX 1 (LENGTH SpaceToUse]
(MAPC SpaceToUse
(FUNCTION
(LAMBDA (Z)
(MapExamples
Z
[FUNCTION
(LAMBDA (I)
(* If the proposed example is
already on Examples, or already
on NonExamples, then we can stop
immediately)
(AND (NOT (MEMBER I (Examples
CurUnit)))
(NOT (MEMBER I (NonExamples
CurUnit)))
(COND
((APPLY* DefnToUse I)
(CPRIN1 57 (QUOTE +))
T)
(T (CPRIN1 59 (QUOTE -))
NIL))
(UnionProp CurUnit
(QUOTE Examples)
I]
400]
(AND (SETQ NewValues (SetDifference (Examples CurUnit)
CurVal))
(SETQ TaskResults (CONS (LIST (QUOTE NewValues)
(LIST CurUnit CurSlot NewValues
(LIST (QUOTE By)
(QUOTE examining)
(QUOTE Examples)
(QUOTE of)
SpaceToUse
(QUOTE ,)
(QUOTE Eurisko)
(QUOTE found)
(LENGTH NewValues)
(QUOTE of)
(QUOTE them)
(QUOTE were)
(QUOTE also)
(QUOTE Examples)
(QUOTE of)
CurUnit)))
TaskResults]
ThenComputeRecord (533544 . 7)
ThenPrintToUserRecord (5014 . 7)
OverallRecord (541853 . 7)
ThenComputeFailedRecord (912711 . 5)
Arity 1)
(PUTPROPS HAvoid IsA (Heuristic Op Anything)
English (IF the current task is to find GSlot of some unit, then make sure that
the slot to change isn't any of these: CSlotSibs)
IfPotentiallyRelevant NULL
Worth 700
Abbrev (Avoid GSlot created by altering CSlotSibs)
IfAboutToWorkOnTask [LAMBDA (task)
(AND NotForReal (IsAKindOf CurSlot (QUOTE GSlot))
(EQ (CADR (ASSOC (QUOTE SlotToChange)
CurSup))
(QUOTE CSlot]
ThenPrintToUser [LAMBDA (task)
(CPRIN1 14 CRLF
"Hm; I have had bad experiences in the past trying to find "
(QUOTE GSlot)
" of units by altering their "
(QUOTE CSlot)
" slot, and this is similar; "
" I'm just going to abort this entire task!"
CRLF)
(SETQ AbortTask? (QUOTE AbortTask!]
Arity 1)
(PUTPROPS HAvoid2 IsA (Heuristic Op Anything)
English (IF the current task is to find GSlot of some unit, then and we did that
by altering its CSlot slot, (or ANY of these slots: CSlotSibs)
then make sure we didn't change a CFrom into anything)
IfPotentiallyRelevant NULL
Worth 700
Abbrev (Avoid GSlot created by altering CFrom in CSlot slot)
IfFinishedWorkingOnTask [LAMBDA
(task)
(AND
NotForReal
(IsAKindOf CurSlot (QUOTE GSlot))
(MEMB (CADR (ASSOC (QUOTE SlotToChange)
CurSup))
(QUOTE CSlotSibs))
(SETQ
DoomedU
(SUBSET
NewUnits
(FUNCTION
(LAMBDA
(U)
(SOME
[CAR
(LAST
(CAR (SOME (Applics
(CAR (Creditors U)))
(FUNCTION
(LAMBDA
(A)
(MEMB U (CADR A]
(FUNCTION (LAMBDA
(Z)
(AND (EQ (CADR Z)
RArrow)
(EQ (CAR Z)
(QUOTE CFrom]
ThenPrintToUser [LAMBDA (C)
(CPRIN1 14 CRLF
"Hm; I have had bad experiences in the past trying to find "
(QUOTE GSlot)
" of units by altering their "
(QUOTE CSlot)
"slot, by changing a `"
(QUOTE CFrom)
"' into a `"
(QUOTE CTo)
"', and this is similar; "
"I have just killed these units: "
DoomedU CRLF)
(SETQ NewUnits (SetDiff NewUnits DoomedU))
T]
ThenDeleteOldConcepts [LAMBDA (C)
(MAPC DoomedU (QUOTE KillUnit))
T]
Arity 1)
(PUTPROPS HAvoid2AND IsA (Heuristic Op Anything)
English (IF the current task is to find Generalizations of some unit, then and
we did that by altering its IfWorkingOnTask slot,
(or ANY of these slots: (IfPotentiallyRelevant IfTrulyRelevant
IfAboutToWorkOnTask
IfWorkingOnTask
IfFinishedWorkingOnTask))
then make sure we didn't change a AND into anything)
IfPotentiallyRelevant NULL
Worth 700
Abbrev (Avoid Generalizations created by altering AND in IfWorkingOnTask slot)
IfFinishedWorkingOnTask [LAMBDA
(task)
(AND
NewUnits
(IsAKindOf CurSlot (QUOTE Generalizations))
(MEMB (CADR (ASSOC (QUOTE SlotToChange)
CurSup))
(QUOTE (IfPotentiallyRelevant
IfTrulyRelevant
IfAboutToWorkOnTask
IfWorkingOnTask
IfFinishedWorkingOnTask)))
(SETQ
DoomedU
(SUBSET
NewUnits
(FUNCTION
(LAMBDA
(U)
(SOME
[CAR
(LAST
(CAR
(SOME (Applics
(CAR (Creditors U)))
(FUNCTION
(LAMBDA
(A)
(MEMB U (CADR A]
(FUNCTION (LAMBDA
(Z)
(AND (EQ (CADR Z)
RArrow)
(EQ (CAR Z)
(QUOTE AND]
ThenPrintToUser [LAMBDA (C)
(CPRIN1 14 CRLF
"Hm; I have had bad experiences in the past trying to find "
(QUOTE Generalizations)
" of units by altering their "
(QUOTE IfWorkingOnTask)
"slot, by changing a `"
(QUOTE AND)
"' into a `"
(QUOTE TheFirstOf)
"', and this is similar; "
"I have just killed these units: "
DoomedU CRLF)
(SETQ NewUnits (SetDiff NewUnits DoomedU))
T]
ThenDeleteOldConcepts [LAMBDA (C)
(MAPC DoomedU (QUOTE KillUnit))
T]
Creditors (H13)
Arity 1)
(PUTPROPS HAvoid3 IsA (Heuristic Op Anything)
English (IF the current task is to find GSlot of some unit, then and we did that
by altering its CSlot slot, (or ANY of these slots: CSlotSibs)
then make sure we didn't change something into a CTo)
IfPotentiallyRelevant NULL
Worth 700
Abbrev (Avoid GSlot created by altering something into a CTo in CSlot slot)
IfFinishedWorkingOnTask [LAMBDA
(task)
(AND
NotForReal
(IsAKindOf CurSlot (QUOTE GSlot))
(MEMB (CADR (ASSOC (QUOTE SlotToChange)
CurSup))
(QUOTE CSlotSibs))
(SETQ
DoomedU
(SUBSET
NewUnits
(FUNCTION
(LAMBDA
(U)
(SOME
[CAR
(LAST (SOME (Applics (CAR (Creditors
U)))
(FUNCTION
(LAMBDA
(A)
(MEMB U (CADR A]
(FUNCTION (LAMBDA
(Z)
(AND (EQ (CADR Z)
RArrow)
(EQ (CADDR Z)
(QUOTE CTo]
ThenPrintToUser [LAMBDA (C)
(CPRIN1 14 CRLF
"Hm; I have had bad experiences in the past trying to find "
(QUOTE GSlot)
" of units by altering their "
(QUOTE CSlot)
"slot, by changing a `"
(QUOTE CFrom)
"' into a `"
(QUOTE CTo)
"', and this is similar; "
"I have just killed these units: "
DoomedU CRLF)
(SETQ NewUnits (SetDiff NewUnits DoomedU))
T]
ThenDeleteOldConcepts [LAMBDA (C)
(MAPC DoomedU (QUOTE KillUnit))
T]
Arity 1)
(PUTPROPS HAvoid3First IsA (Heuristic Op Anything)
English (IF the current task is to find Generalizations of some unit, then
and we did that by altering its IfWorkingOnTask slot,
(or ANY of these slots: (IfPotentiallyRelevant IfTrulyRelevant
IfAboutToWorkOnTask
IfWorkingOnTask
IfFinishedWorkingOnTask))
then make sure we didn't change something into a TheFirstOf)
IfPotentiallyRelevant NULL
Worth 700
Abbrev (Avoid Generalizations created by altering something into a
TheFirstOf in IfWorkingOnTask slot)
IfFinishedWorkingOnTask [LAMBDA
(task)
(AND
NewUnits
(IsAKindOf CurSlot (QUOTE Generalizations))
(MEMB (CADR (ASSOC (QUOTE SlotToChange)
CurSup))
(QUOTE (IfPotentiallyRelevant
IfTrulyRelevant
IfAboutToWorkOnTask
IfWorkingOnTask
IfFinishedWorkingOnTask)))
(SETQ
DoomedU
(SUBSET
NewUnits
(FUNCTION
(LAMBDA
(U)
(SOME
[CAR
(LAST
(SOME (Applics
(CAR (Creditors U)))
(FUNCTION
(LAMBDA
(A)
(MEMB U (CADR A]
(FUNCTION
(LAMBDA (Z)
(AND (EQ (CADR Z)
RArrow)
(EQ (CADDR Z)
(QUOTE TheFirstOf]
ThenPrintToUser [LAMBDA (C)
(CPRIN1 14 CRLF
"Hm; I have had bad experiences in the past trying to find "
(QUOTE Generalizations)
" of units by altering their "
(QUOTE IfWorkingOnTask)
"slot, by changing a `"
(QUOTE AND)
"' into a `"
(QUOTE TheFirstOf)
"', and this is similar; "
"I have just killed these units: "
DoomedU CRLF)
(SETQ NewUnits (SetDiff NewUnits DoomedU))
T]
ThenDeleteOldConcepts [LAMBDA (C)
(MAPC DoomedU (QUOTE KillUnit))
T]
Creditors (H14)
Arity 1)
(PUTPROPS HAvoidIfWorking IsA (Heuristic Op Anything)
English (IF the current task is to find Generalizations of some unit,
then think twice if the slot to change is IfWorkingOnTask)
IfPotentiallyRelevant NULL
Worth 700
Abbrev (Avoid Generalizations created by altering IfWorkingOnTask)
IfAboutToWorkOnTask [LAMBDA (task)
(* Note the element of chance in whether this
advice is followed or not)
(AND (IsAKindOf CurSlot (QUOTE
Generalizations))
(EQ (CADR (ASSOC (QUOTE SlotToChange)
CurSup))
(QUOTE IfWorkingOnTask))
(NEQ 1 (RAND 1 10]
ThenPrintToUser [LAMBDA (task)
(CPRIN1 14 CRLF
"Hm; I have had bad experiences in the past trying to find "
(QUOTE Generalizations)
" of units by altering their "
(QUOTE IfWorkingOnTask)
" slot, and this is similar; "
" I'm just going to abort this entire task!"
CRLF)
(SETQ AbortTask? (QUOTE AbortTask!]
Arity 1)
(PUTPROPS Heuristic Worth 900
Examples (H1 H5 H6 H3 H4 H7 H8 H9 H10 H11 H2 H12 HAvoid HAvoid2 HAvoid3 H13 H14
H15 H16 H17 H18 H19 HAvoid2AND HAvoid3First HAvoidIfWorking
H5Criterial H5Good H19Criterial H20 H21 H22 H23 H24 H25 H26 H27
H28 H29 H1-6)
IsA (ReprConcept Anything Category)
Generalizations (Op Anything ReprConcept)
Specializations (HindSightRule))
(PUTPROPS HindSightRule Worth 900
IsA (ReprConcept Anything Category)
Generalizations (Op Heuristic Anything ReprConcept)
Abbrev (Heuristic rules for learning from bitter experiences)
Examples (H12 H13 H14))
(PUTPROPS IEQP Worth 500
IsA (MathConcept MathOp Op MathPred Pred Anything NumOp BinaryOp BinaryPred)
FastAlg [LAMBDA (X Y)
(IEQP X Y]
Arity 2
Domain (NNumber NNumber)
Range (Bit)
Generalizations (EQUAL ILEQ IGEQ)
ElimSlots (Applics)
IsAInt (BinaryPred)
Rarity (.1 1 9))
(PUTPROPS IGEQ Worth 509
IsA (MathConcept MathOp Op MathPred Pred Anything NumOp BinaryOp BinaryPred)
FastAlg [LAMBDA (X Y)
(IGEQ X Y]
Arity 2
Domain (NNumber NNumber)
Range (Bit)
Specializations (IEQP IGREATERP)
Transpose (ILEQ)
ElimSlots (Applics))
(PUTPROPS IGREATERP Worth 501
IsA (MathConcept MathOp Op MathPred Pred Anything NumOp BinaryOp BinaryPred)
FastAlg [LAMBDA (X Y)
(IGREATERP X Y]
Arity 2
Domain (NNumber NNumber)
Range (Bit)
Generalizations (IGEQ)
Transpose (ILESSP)
ElimSlots (Applics))
(PUTPROPS ILEQ Worth 500
IsA (MathConcept MathOp Op MathPred Pred Anything NumOp BinaryOp BinaryPred)
FastAlg [LAMBDA (X Y)
(ILEQ X Y]
Arity 2
Domain (NNumber NNumber)
Range (Bit)
Specializations (IEQP ILESSP)
Transpose (IGEQ)
ElimSlots (Applics))
(PUTPROPS ILESSP Worth 500
IsA (MathConcept MathOp Op MathPred Pred Anything NumOp BinaryOp BinaryPred)
FastAlg [LAMBDA (X Y)
(ILESSP X Y]
Arity 2
Domain (NNumber NNumber)
Range (Bit)
Generalizations (ILEQ)
Transpose (IGREATERP)
ElimSlots (Applics))
(PUTPROPS IfAboutToWorkOnTask Worth 600
IsA (Slot CriterialSlot ReprConcept Anything)
SuperSlots (IfParts IfTaskParts)
DataType LispPred)
(PUTPROPS IfFinishedWorkingOnTask Worth 600
IsA (Slot CriterialSlot ReprConcept Anything)
SuperSlots (IfTaskParts IfParts)
DataType LispPred)
(PUTPROPS IfParts Worth 600
SubSlots (IfPotentiallyRelevant IfTrulyRelevant IfAboutToWorkOnTask
IfWorkingOnTask IfFinishedWorkingOnTask)
IsA (Slot CriterialSlot ReprConcept Anything)
DataType LispPred)
(PUTPROPS IfPotentiallyRelevant Worth 600
IsA (Slot CriterialSlot ReprConcept Anything)
SuperSlots (IfParts)
DataType LispPred)
(PUTPROPS IfTaskParts Worth 600
IsA (Slot CriterialSlot ReprConcept Anything)
SubSlots (IfAboutToWorkOnTask IfWorkingOnTask IfFinishedWorkingOnTask)
DataType LispPred)
(PUTPROPS IfTrulyRelevant Worth 600
IsA (Slot CriterialSlot ReprConcept Anything)
SuperSlots (IfParts)
DataType LispPred)
(PUTPROPS IfWorkingOnTask Worth 600
IsA (Slot CriterialSlot ReprConcept Anything)
SuperSlots (IfParts IfTaskParts)
DataType LispPred)
(PUTPROPS InDomainOf Inverse (Domain)
IsA (Slot NonCriterialSlot ReprConcept Anything)
Worth 300
DataType Unit)
(PUTPROPS IndirectApplics Worth 300
IsA (Slot NonCriterialSlot ReprConcept Anything)
Format ((situation resultant-units directness)
(situation resultant-units directness)
etc.)
DataType IOPair
SuperSlots (Applics)
DoubleCheck T
DontCopy T)
(PUTPROPS Inverse Worth 600
IsA (Slot NonCriterialSlot ReprConcept Anything)
Inverse (Inverse)
DataType Slot
DoubleCheck T)
(PUTPROPS IsA Worth 300
IsA (Slot NonCriterialSlot ReprConcept Anything)
Inverse (Examples)
DataType Unit
DoubleCheck T)
(PUTPROPS IsRangeOf Worth 300
IsA (Slot NonCriterialSlot ReprConcept Anything)
DataType Unit
Inverse (Range))
(PUTPROPS IterativeAlg SuperSlots (Alg)
IsA (Slot CriterialSlot ReprConcept Anything)
Worth 600
DataType LispFn)
(PUTPROPS IterativeDefn SuperSlots (Defn)
Worth 600
IsA (Slot CriterialSlot ReprConcept Anything)
DataType LispPred)
(PUTPROPS MathConcept Generalizations (Anything)
Worth 500
Examples (NNumber PrimeNum PerfNum PerfSquare OddNum EvenNum Square
DivisorsOf Multiply Add Successor Set SetOfNumbers
RandomChoose RandomSubset GoodChoose BestChoose BestSubset
GoodSubset Bit EQUAL IEQP EQ ILEQ IGEQ ILESSP IGREATERP
Slot Unit CriterialSlot NonCriterialSlot MathConcept
MathObj MathOp MathPred NumOp SetOp los1 los2 los3 los4
los5 los6 los7 win1 RecordSlot Structure StrucEqual
SetEqual Subsetp Compose StrucInsert StrucOp StrucDelete
SetInsert SetDelete ListOp List ListInsert ListDelete
ListDelete1 Bag BagOp BagInsert BagDelete BagDelete1
MultEleStruc MultEleStrucOp MultEleStrucDelete1 OSet
OSetInsert OSetOp OSetDelete NoMultEleStruc OrdStruc
UnOrdStruc OSetEqual BagEqual ListEqual OrdStrucOp
OrdStrucEqual SetIntersect SetUnion StrucIntersect
ListIntersect OSetIntersect BagIntersect StrucUnion
OSetUnion ListUnion BagUnion StrucDifference SetDifference
ListDifference OSetDifference BagDifference Coalesce
ParallelReplace ParallelReplace2 Repeat Repeat2
ParallelJoin ParallelJoin2 OPair Pair ReverseOPair FirstEle
SecondEle ThirdEle AllButFirst AllButSecond AllButThird
LastEle AllButLast MEMBER MEMB Proj1 Proj2 Proj1of3
Proj2of3 Proj3of3 Identity1 Restrict InvertedOp InvertOp
SetOfOPairs Relation LogicOp StructureOfStructures
SetOfSets EmptyStruc NonEmptyStruc MultEleStrucInsert
RestricRandomSubset-3)
Specializations (MathOp MathObj SetOp UnitOp NumOp MathPred StrucOp ListOp
BagOp MultEleStrucOp OSetOp OrdStrucOp InvertedOp
LogicOp)
IsA (MathConcept MathObj Anything Category))
(PUTPROPS MathObj Generalizations (MathConcept Anything)
Worth 500
Examples (NNumber PrimeNum PerfNum PerfSquare OddNum EvenNum Set SetOfNumbers Bit
MathConcept NumOp SetOp MathPred MathObj MathOp los1 los2 los3
los4 los5 los6 los7 win1 Structure StrucOp ListOp List Bag
BagOp MultEleStruc MultEleStrucOp OSet OSetOp NoMultEleStruc
OrdStruc UnOrdStruc OrdStrucOp OPair Pair InvertedOp
SetOfOPairs Relation LogicOp StructureOfStructures SetOfSets
EmptyStruc NonEmptyStruc TruthValue)
IsA (MathConcept MathObj Anything Category))
(PUTPROPS MathOp Generalizations (MathConcept Op Anything)
Worth 500
Examples (DivisorsOf Square Multiply Add Successor RandomChoose RandomSubset
GoodChoose BestChoose BestSubset GoodSubset EQUAL IEQP EQ
ILEQ IGEQ ILESSP IGREATERP AND OR TheFirstOf TheSecondOf
StrucEqual SetEqual Subsetp Compose StrucInsert StrucDelete
SetInsert SetDelete ListInsert ListDelete ListDelete1
BagInsert BagDelete BagDelete1 MultEleStrucDelete1 OSetInsert
OSetDelete OSetEqual BagEqual ListEqual OrdStrucEqual
SetIntersect SetUnion StrucIntersect ListIntersect
OSetIntersect BagIntersect StrucUnion OSetUnion ListUnion
BagUnion StrucDifference SetDifference ListDifference
OSetDifference BagDifference Coalesce ParallelReplace
ParallelReplace2 Repeat Repeat2 ParallelJoin ParallelJoin2
ReverseOPair FirstEle SecondEle ThirdEle AllButFirst
AllButSecond AllButThird LastEle AllButLast MEMBER MEMB Proj1
Proj2 Proj1of3 Proj2of3 Proj3of3 Identity1 Restrict InvertOp
NOT Implies AlwaysNIL AlwaysNIL2 AlwaysT AlwaysT2
ConstantBinaryPred ConstantPred ConstantUnaryPred
UndefinedPred MultEleStrucInsert RestricRandomSubset-3)
IsA (MathConcept MathObj Anything Category)
Specializations (SetOp UnitOp NumOp StrucOp ListOp BagOp MultEleStrucOp OSetOp
OrdStrucOp InvertedOp LogicOp))
(PUTPROPS MathPred Generalizations (MathConcept Op Pred Anything)
Worth 500
IsA (MathConcept MathObj Anything Category)
Examples (EQUAL IEQP EQ ILEQ IGEQ ILESSP IGREATERP AND OR TheFirstOf TheSecondOf
StrucEqual SetEqual Subsetp OSetEqual BagEqual ListEqual MEMBER
MEMB NOT Implies))
(PUTPROPS Multiply Worth 500
IsA (MathConcept MathOp Op NumOp Anything BinaryOp)
FastAlg [LAMBDA (X Y)
(TIMES X Y]
RecursiveAlg [LAMBDA (X Y)
(COND ((EQ X 0)
0)
((EQ X 1)
Y)
(T (RunAlg (QUOTE Add)
Y
(RunAlg (QUOTE Multiply)
(SUB1 X)
Y]
UnitizedAlg [LAMBDA (X Y)
(COND ((EQ X 0)
0)
((EQ X 1)
Y)
(T (RunAlg (QUOTE Add)
Y
(RunAlg (QUOTE Multiply)
(SUB1 X)
Y]
IterativeAlg [LAMBDA (X Y)
(for i from 1 to X sum Y]
Arity 2
Domain (NNumber NNumber)
Range (NNumber)
ElimSlots (Applics))
(PUTPROPS NNumber Worth 500
IsA (MathConcept MathObj Anything Category)
Specializations (PrimeNum PerfNum PerfSquare OddNum EvenNum)
Generator ((0) (ADD1) (old))
FastDefn FIXP
InDomainOf (DivisorsOf Multiply Add Successor Square IEQP ILEQ IGEQ ILESSP
IGREATERP)
IsRangeOf (Multiply Add Successor)
ElimSlots (Examples)
Generalizations (Anything)
Rarity (0 1 3))
(PUTPROPS NonCriterialSlot IsA (ReprConcept MathConcept Anything Category)
Worth 500
Generalizations (Slot Anything ReprConcept)
Examples (Abbrev Applics Arity Creditors DirectApplics DontCopy
DoubleCheck English Examples Format Generalizations
InDomainOf IndirectApplics IsA IsRangeOf Range SibSlots
Specializations SubSlots SuperSlots Transpose Worth
Inverse Subsumes SubsumedBy OverallRecord
ThenPrintToUserFailedRecord ThenAddToAgendaFailedRecord
ThenDeleteOldConceptsFailedRecord
ThenDefineNewConceptsFailedRecord
ThenConjectureFailedRecord ThenModifySlotsFailedRecord
ThenComputeFailedRecord ThenPrintToUserRecord
ThenAddToAgendaRecord ThenDeleteOldConceptsRecord
ThenDefineNewConceptsRecord ThenConjectureRecord
ThenModifySlotsRecord ThenComputeRecord RecordFor
FailedRecordFor Record FailedRecord Conjectures
ConjectureAbout LowerArity HigherArity Extensions
Restrictions Interestingness MoreInteresting
LessInteresting IntExamples WhyInt Rarity IsAInt
IntApplics))
(PUTPROPS NonExamples Worth 600
IsA (Slot CriterialSlot ReprConcept Anything)
DataType Unit
DoubleCheck T
DontCopy T)
(PUTPROPS NumOp Generalizations (MathConcept Op MathOp Anything)
Worth 500
IsA (MathConcept MathObj Anything Category)
Abbrev (Numeric Operations)
Examples (DivisorsOf Square Multiply Add Successor IEQP ILEQ IGEQ ILESSP IGREATERP)
)
(PUTPROPS OR Worth 500
IsA (Op Pred MathOp MathPred Anything BinaryOp LogicOp BinaryPred)
FastAlg [LAMBDA (X Y)
(OR X Y]
Arity 2
Domain (Anything Anything)
Range (Anything)
ElimSlots (Applics)
Specializations (TheFirstOf TheSecondOf AND))
(PUTPROPS OddNum Generalizations (NNumber Anything)
Worth 700
UnitizedDefn [LAMBDA (n)
(NOT (RunAlg Divides 2 n]
IsA (MathConcept MathObj Anything Category)
FastDefn [LAMBDA (n)
(AND (FIXP n)
(EQ 1 (REMAINDER n 2]
ElimSlots (Examples))
(PUTPROPS Op Worth 500
IsA (ReprConcept Anything Category)
Specializations (MathOp Heuristic SetOp UnitOp NumOp Pred MathPred HindSightRule
ConstantPred StrucOp ListOp BagOp MultEleStrucOp OSetOp
OrdStrucOp UnaryOp BinaryOp TertiaryOp InvertedOp LogicOp
UnaryPred BinaryPred TertiaryPred)
Examples (RandomChoose RandomSubset GoodChoose BestChoose BestSubset GoodSubset
DivisorsOf Square Multiply Add Successor EQUAL IEQP EQ ILEQ
IGEQ ILESSP IGREATERP H12 H13 H14 H1 H5 H6 H3 H4 H7 H8 H9 H10
H11 H2 HAvoid HAvoid2 HAvoid3 H15 AND OR TheSecondOf TheFirstOf
H19 HAvoid2AND HAvoid3First HAvoidIfWorking H5Criterial H5Good
H19Criterial H20 H21 StrucEqual SetEqual Subsetp AlwaysT
AlwaysNIL ConstantBinaryPred AlwaysT2 AlwaysNIL2
ConstantUnaryPred Compose UndefinedPred StrucInsert StrucDelete
SetInsert SetDelete ListInsert ListDelete ListDelete1 BagInsert
BagDelete BagDelete1 MultEleStrucDelete1 OSetInsert OSetDelete
OSetEqual BagEqual ListEqual OrdStrucEqual SetIntersect
SetUnion StrucIntersect ListIntersect OSetIntersect
BagIntersect StrucUnion OSetUnion ListUnion BagUnion
StrucDifference SetDifference ListDifference OSetDifference
BagDifference Coalesce ParallelReplace ParallelReplace2 Repeat
Repeat2 ParallelJoin ParallelJoin2 ReverseOPair FirstEle
SecondEle ThirdEle AllButFirst AllButSecond AllButThird LastEle
AllButLast MEMBER MEMB Proj1 Proj2 Proj1of3 Proj2of3 Proj3of3
Identity1 Restrict InvertOp NOT Implies H22 H23 H24 H29 H16 H17
H18 H25 H26 H27 H28 MultEleStrucInsert H1-6)
Generalizations (Anything)
InDomainOf (Compose Coalesce Restrict InvertOp)
IsRangeOf (Compose Coalesce Restrict))
(PUTPROPS OverallRecord Worth 300
IsA (Slot NonCriterialSlot ReprConcept Anything RecordSlot)
DataType DottedPair
DontCopy T)
(PUTPROPS PerfNum Generalizations (NNumber Anything)
Worth 800
UnitizedDefn [LAMBDA (n)
(EQ (RunAlg (QUOTE Double)
n)
(APPLY (QUOTE PLUS)
(RunAlg (QUOTE DivisorsOf)
n]
IsA (MathConcept MathObj Anything Category)
IterativeDefn [LAMBDA (n)
(AND (FIXP n)
(EQ (SUB1 n)
(for i from 2 to (SUB1 n)
sum
(COND ((Divides i n)
i)
(T 0]
ElimSlots NIL
NonExamples (0 1)
Examples (6 28))
(PUTPROPS PerfSquare Generalizations (NNumber Anything)
Worth 950
IsRangeOf (Square)
IsA (MathConcept MathObj Anything Category)
ElimSlots (Examples))
(PUTPROPS Pred Generalizations (Op Anything)
Worth 500
IsA (ReprConcept Anything Category)
Abbrev (Boolean predicates)
Specializations (MathPred ConstantPred UnaryPred BinaryPred TertiaryPred)
Examples (EQUAL IEQP EQ ILEQ IGEQ ILESSP IGREATERP AND OR TheSecondOf TheFirstOf
StrucEqual SetEqual Subsetp AlwaysT AlwaysNIL ConstantBinaryPred
AlwaysT2 AlwaysNIL2 ConstantUnaryPred UndefinedPred OSetEqual
BagEqual ListEqual MEMBER MEMB NOT Implies))
(PUTPROPS PrimeNum Generalizations (NNumber Anything)
Worth 950
UnitizedDefn [LAMBDA (n)
(RunDefn (RunAlg (QUOTE DivisorsOf)
n)
(QUOTE Doubleton]
IsA (MathConcept MathObj Anything Category)
IterativeDefn [LAMBDA (n)
(AND (FIXP n)
(EQ 0 (for i from 2 to (SUB1 n)
sum
(COND ((Divides i n)
i)
(T 0]
FastDefn [LAMBDA (n)
(AND (FIXP n)
(for i from 2 to (ISQRT n)
never
(Divides i n]
NonExamples (0 1)
ElimSlots (Examples))
(PUTPROPS ProtoConjec Worth 802
IsA (Conjecture ReprConcept Anything))
(PUTPROPS RandomChoose Worth 507
IsA (MathConcept MathOp Op SetOp Anything StrucOp UnaryOp)
FastAlg RandomChoose
Domain (Set)
Range (Anything)
Specializations (GoodChoose BestChoose)
ElimSlots (Applics)
Arity 1)
(PUTPROPS RandomSubset Worth 520
IsA (MathConcept MathOp Op SetOp Anything StrucOp UnaryOp)
FastAlg RandomSubset
Domain (Set)
Range (Set)
Specializations (BestSubset GoodSubset)
ElimSlots (Applics)
Arity 1
Rarity (.4065041 50 73))
(PUTPROPS Range Worth 300
IsA (Slot NonCriterialSlot ReprConcept Anything)
DataType Unit
Inverse (IsRangeOf))
(PUTPROPS Record Worth 600
IsA (Slot NonCriterialSlot ReprConcept Anything)
DoubleCheck T
DataType Slot
Inverse (RecordFor))
(PUTPROPS RecordFor Worth 600
IsA (Slot NonCriterialSlot ReprConcept Anything)
DoubleCheck T
DataType Slot
Inverse (Record))
(PUTPROPS RecordSlot IsA (ReprConcept MathConcept Anything Category)
Worth 500
Generalizations (Slot Anything ReprConcept)
Examples (ThenComputeRecord ThenComputeFailedRecord ThenModifySlotsRecord
ThenModifySlotsFailedRecord ThenConjectureRecord
ThenConjectureFailedRecord
ThenDefineNewConceptsRecord
ThenDefineNewConceptsFailedRecord
ThenDeleteOldConceptsRecord
ThenDeleteOldConceptsFailedRecord
ThenAddToAgendaRecord ThenAddToAgendaFailedRecord
ThenPrintToUserRecord ThenPrintToUserFailedRecord
OverallRecord))
(PUTPROPS RecursiveAlg SuperSlots (Alg)
IsA (Slot CriterialSlot ReprConcept Anything)
Worth 600
DataType LispFn)
(PUTPROPS RecursiveDefn SuperSlots (Defn)
Worth 600
IsA (Slot CriterialSlot ReprConcept Anything)
DataType LispPred)
(PUTPROPS ReprConcept Generalizations (Anything)
Worth 500
Examples (Slot Unit CriterialSlot NonCriterialSlot Heuristic HindSightRule
UnitOp UnaryUnitOp ReprConcept Conjecture Task Anything Pred
Op ProtoConjec Abbrev Alg ApplicGenerator Applics Arity
CompiledDefn Creditors DataType Defn DirectApplics Domain
DontCopy DoubleCheck ElimSlots English Examples FailedRecord
FailedRecordFor FastAlg FastDefn Format Generalizations
Generator IfAboutToWorkOnTask IfFinishedWorkingOnTask IfParts
IfPotentiallyRelevant IfTaskParts IfTrulyRelevant
IfWorkingOnTask InDomainOf IndirectApplics Inverse IsA
IsRangeOf IterativeAlg IterativeDefn NonExamples OverallRecord
Range Record RecordFor RecursiveAlg RecursiveDefn SibSlots
Specializations SubSlots SubsumedBy Subsumes SuperSlots
ThenAddToAgenda ThenAddToAgendaFailedRecord
ThenAddToAgendaRecord ThenCompute ThenComputeFailedRecord
ThenComputeRecord ThenConjecture ThenConjectureFailedRecord
ThenConjectureRecord ThenDefineNewConcepts
ThenDefineNewConceptsFailedRecord ThenDefineNewConceptsRecord
ThenDeleteOldConcepts ThenDeleteOldConceptsFailedRecord
ThenDeleteOldConceptsRecord ThenModifySlots
ThenModifySlotsFailedRecord ThenModifySlotsRecord ThenParts
ThenPrintToUser ThenPrintToUserFailedRecord
ThenPrintToUserRecord ToDelete ToDelete1 Transpose UnitizedAlg
UnitizedDefn Worth RecordSlot Conjectures ConjectureAbout
Category NecDefn SufDefn TypeOfStructure UnaryOp
EachElementIsA BinaryOp TertiaryOp Atom ConstantPred Undefined
LowerArity HigherArity UnaryPred BinaryPred TertiaryPred
PredCatByNArgs OpCatByNArgs Extensions Restrictions
Interestingness MoreInteresting LessInteresting IntExamples
WhyInt Rarity IsAInt IntApplics English-1)
IsA (ReprConcept Anything Category)
Specializations (Slot CriterialSlot NonCriterialSlot Unit Heuristic
HindSightRule RecordSlot))
(PUTPROPS Set Worth 500
IsA (MathConcept MathObj Anything Category TypeOfStructure)
Generator ((NIL)
(GetASet)
(old))
FastDefn [LAMBDA (s)
(OR (EQ s NIL)
(NoRepeatsIn s]
RecursiveDefn [LAMBDA (s)
(COND ((NLISTP s)
(EQ s NIL))
(T (AND (NOT (MEMBER (CAR s)
(CDR s)))
(RunDefn (QUOTE Set)
(CDR s]
InDomainOf (RandomChoose RandomSubset GoodChoose BestChoose BestSubset GoodSubset
SetEqual Subsetp SetInsert SetDelete SetIntersect SetUnion
SetDifference)
IsRangeOf (RandomSubset BestSubset GoodSubset SetInsert SetDelete SetIntersect
SetUnion SetDifference RestricRandomSubset-2-1
RestricRandomSubset-1-2)
Generalizations (Anything Structure Bag List NoMultEleStruc UnOrdStruc)
Specializations (OSet EmptyStruc NonEmptyStruc)
Rarity (0 2 2)
ElimSlots (Examples))
(PUTPROPS SetEqual Worth 500
IsA (MathConcept MathOp Op MathPred Pred Anything StrucOp SetOp BinaryOp
BinaryPred)
Arity 2
Domain (Set Set)
Range (Bit)
ElimSlots (Applics)
Generalizations (EQUAL StrucEqual Subsetp)
FastAlg [LAMBDA (s1 s2)
(COND ((NEQ (LENGTH s1)
(LENGTH s2))
NIL)
((EQUAL s1 s2)
T)
(T (AND (IsSubsetOf s1 s2)
(IsSubsetOf s2 s1]
RecursiveAlg [LAMBDA (s1 s2)
(COND ((AND (NULL s1)
(NULL s2))
T)
(T (AND (LISTP s1)
(LISTP s2)
(MEMBER (CAR s1)
s2)
(RunAlg (QUOTE SetEqual)
(CDR s1)
(REMOVE (CAR s1)
s2]
UnitizedAlg [LAMBDA (s1 s2)
(AND (RunAlg (QUOTE Subsetp)
s1 s2)
(RunAlg (QUOTE Subsetp)
s2 s1]
Specializations (OSetEqual)
IsAInt (BinaryPred)
Rarity (.1 1 9))
(PUTPROPS SetOfNumbers IsRangeOf (DivisorsOf)
IsA (MathConcept MathObj Anything Category)
Worth 500
UnitizedDefn [LAMBDA (s)
(AND (RunDefn (QUOTE Set)
s)
(EVERY s (FUNCTION (LAMBDA (n)
(RunDefn (QUOTE NNumber)
n]
FastDefn [LAMBDA (s)
(AND (RunDefn (QUOTE Set)
s)
(EVERY s (QUOTE NUMBERP]
ElimSlots (Examples)
Generalizations (Anything)
EachElementIsA NNumber)
(PUTPROPS SetOp Generalizations (MathConcept Op MathOp Anything StrucOp)
Worth 500
IsA (MathConcept MathObj Anything Category)
Abbrev (Set Operations)
Specializations (UnitOp)
Examples (RandomChoose RandomSubset GoodChoose BestChoose BestSubset GoodSubset
SetInsert SetDelete SetEqual SetIntersect SetUnion
SetDifference))
(PUTPROPS SibSlots Worth 300
IsA (Slot NonCriterialSlot ReprConcept Anything)
Inverse (SibSlots)
DataType Slot
DoubleCheck T)
(PUTPROPS Slot IsA (ReprConcept MathConcept Anything Category)
Worth 530
Examples (IfAboutToWorkOnTask Applics IfFinishedWorkingOnTask IsA IfTrulyRelevant
SubSlots IfParts IfPotentiallyRelevant Examples
DataType English Worth Inverse Creditors
Generalizations Specializations ThenAddToAgenda
ThenCompute ThenConjecture Abbrev
ThenDefineNewConcepts ThenModifySlots ThenPrintToUser
ThenParts SuperSlots IfTaskParts Format DontCopy
DoubleCheck Generator IfWorkingOnTask IsRangeOf
ToDelete1 Alg FastDefn RecursiveDefn UnitizedDefn
FastAlg IterativeAlg RecursiveAlg UnitizedAlg
IterativeDefn ToDelete ApplicGenerator Arity
NonExamples CompiledDefn ElimSlots InDomainOf Domain
Range IndirectApplics DirectApplics Defn SibSlots
Transpose ThenDeleteOldConcepts Subsumes SubsumedBy
OverallRecord ThenPrintToUserFailedRecord
ThenAddToAgendaFailedRecord
ThenDeleteOldConceptsFailedRecord
ThenDefineNewConceptsFailedRecord
ThenConjectureFailedRecord ThenModifySlotsFailedRecord
ThenComputeFailedRecord ThenPrintToUserRecord
ThenAddToAgendaRecord ThenDeleteOldConceptsRecord
ThenDefineNewConceptsRecord ThenConjectureRecord
ThenModifySlotsRecord ThenComputeRecord RecordFor
FailedRecordFor Record FailedRecord Conjectures
ConjectureAbout NecDefn SufDefn EachElementIsA
LowerArity HigherArity Extensions Restrictions
Interestingness MoreInteresting LessInteresting
IntExamples WhyInt Rarity IsAInt IntApplics)
Specializations (CriterialSlot NonCriterialSlot RecordSlot)
Generalizations (UnaryUnitOp ReprConcept Anything))
(PUTPROPS Specializations Worth 356
IsA (Slot NonCriterialSlot ReprConcept Anything)
SubSlots (SubSlots Restrictions)
Inverse (Generalizations)
DataType Unit
DoubleCheck T)
(PUTPROPS Square Worth 500
UnitizedAlg [LAMBDA (n)
(RunAlg (QUOTE Multiply)
n n]
IsA (MathConcept MathOp Op NumOp Anything UnaryOp)
FastAlg [LAMBDA (n)
(ITIMES n n]
Domain (NNumber)
Range (PerfSquare)
ElimSlots (Applics)
Arity 1
Rarity (1.0 220 0))
(PUTPROPS StrucEqual Worth 500
IsA (MathConcept MathOp Op MathPred Pred Anything BinaryOp BinaryPred)
Arity 2
Domain (Structure Structure)
Range (Bit)
ElimSlots (Applics)
Generalizations (EQUAL)
Specializations (SetEqual OSetEqual BagEqual ListEqual)
IsAInt (BinaryPred)
Rarity (.02 1 49))
(PUTPROPS Structure Worth 500
IsA (MathConcept MathObj Anything Category)
FastDefn [LAMBDA (s)
(OR (NULL s)
(LISTP s]
RecursiveDefn [LAMBDA (s)
(COND ((NLISTP s)
(EQ s NIL))
(T (RunDefn (QUOTE Structure)
(CDR s]
Generalizations (Anything)
Specializations (Set List Bag MultEleStruc OSet NoMultEleStruc OrdStruc
UnOrdStruc OPair Pair EmptyStruc NonEmptyStruc)
InDomainOf (StrucEqual StrucInsert StrucDelete StrucIntersect StrucUnion
StrucDifference MEMBER MEMB)
IsRangeOf (StrucInsert StrucDelete StrucIntersect StrucUnion StrucDifference)
Interestingness [SOME
(Examples (QUOTE UnaryPred))
(FUNCTION
(LAMBDA
(P)
(AND
[OR (HasHighWorth P)
(MEMB P (IntExamples (QUOTE UnaryPred]
(LEQNN (CAR (Rarity P))
.3)
[SETQ tempdef (Defn (CAR (Domain P]
(EVERY u tempdef)
[SETQ tempdef (SUBSET u (FUNCTION (LAMBDA (e)
(RunAlg
P e]
[SETQ
temp2
(CAR (SOME (OKBinPreds u)
(FUNCTION
(LAMBDA
(P2)
(AND (RunDefn (CADR (Domain P2))
tempdef)
(RunAlg P2 u tempdef]
(CPRIN1 14 CRLF "The set of elements of " u
" which satisfy the rare predicate "
P
" form a very special subset; namely, there are in relation "
temp2 " to the entire structure." CRLF)
(CPRIN1 40 TAB "They are, by the way: " tempdef CRLF]
Rarity (0 2 2))
(PUTPROPS SubSlots Worth 300
IsA (Slot NonCriterialSlot ReprConcept Anything)
Inverse (SuperSlots)
SuperSlots (Specializations)
DataType Slot
DoubleCheck T)
(PUTPROPS Subsetp Worth 500
IsA (MathConcept MathOp Op MathPred Pred Anything BinaryOp BinaryPred)
Arity 2
Domain (Set Set)
Range (Bit)
ElimSlots (Applics)
Specializations (SetEqual OSetEqual)
RecursiveAlg [LAMBDA (s1 s2)
(COND ((NULL s1)
T)
(T (AND (LISTP s1)
(MEMBER (CAR s1)
s2)
(RunAlg (QUOTE Subsetp)
(CDR s1)
s2]
FastAlg IsSubsetOf)
(PUTPROPS SubsumedBy Worth 300
IsA (Slot NonCriterialSlot ReprConcept Anything)
Inverse (Subsumes)
DataType Unit
DoubleCheck T)
(PUTPROPS Subsumes Worth 300
IsA (Slot NonCriterialSlot ReprConcept Anything)
DataType Unit
DoubleCheck T
Inverse (SubsumedBy))
(PUTPROPS Successor Worth 500
IsA (MathConcept MathOp Op NumOp Anything UnaryOp)
FastAlg [LAMBDA (X Y)
(ADD1 X Y]
Domain (NNumber)
Range (NNumber)
ElimSlots (Applics)
Arity 1)
(PUTPROPS SuperSlots Worth 300
Inverse (SubSlots)
IsA (Slot NonCriterialSlot ReprConcept Anything)
SuperSlots (Generalizations)
DataType Slot
DoubleCheck T)
(PUTPROPS Task Worth 500
Format (priority-value unit-name slot-name reasons misc-args)
IsA (ReprConcept Anything Category)
Generalizations (Anything))
(PUTPROPS TheFirstOf Worth 500
IsA (Op Pred MathOp MathPred Anything BinaryOp LogicOp BinaryPred)
FastAlg [LAMBDA (X Y)
X]
Arity 2
Domain (Anything Anything)
Range (Anything)
ElimSlots (Applics)
Specializations (AND)
Generalizations (OR)
Rarity (1.0 42 0))
(PUTPROPS TheSecondOf Worth 500
IsA (Op Pred MathOp MathPred Anything BinaryOp LogicOp BinaryPred)
FastAlg [LAMBDA (X Y)
Y]
Arity 2
Domain (Anything Anything)
Range (Anything)
ElimSlots (Applics)
Specializations (AND)
Generalizations (OR))
(PUTPROPS ThenAddToAgenda Worth 600
IsA (Slot CriterialSlot ReprConcept Anything)
SuperSlots (ThenParts)
DataType LispFn
FailedRecord (ThenAddToAgendaFailedRecord)
Record (ThenAddToAgendaRecord))
(PUTPROPS ThenAddToAgendaFailedRecord Worth 300
IsA (Slot NonCriterialSlot ReprConcept RecordSlot Anything)
DataType DottedPair
FailedRecordFor (ThenAddToAgenda)
DontCopy T)
(PUTPROPS ThenAddToAgendaRecord Worth 300
IsA (Slot NonCriterialSlot ReprConcept RecordSlot Anything)
DataType DottedPair
RecordFor (ThenAddToAgenda)
DontCopy T)
(PUTPROPS ThenCompute Worth 600
IsA (Slot CriterialSlot ReprConcept Anything)
SuperSlots (ThenParts)
DataType LispFn
FailedRecord (ThenComputeFailedRecord)
Record (ThenComputeRecord))
(PUTPROPS ThenComputeFailedRecord Worth 300
IsA (Slot NonCriterialSlot ReprConcept RecordSlot Anything)
DataType DottedPair
FailedRecordFor (ThenCompute)
DontCopy T)
(PUTPROPS ThenComputeRecord Worth 300
IsA (Slot NonCriterialSlot ReprConcept RecordSlot Anything)
DataType DottedPair
RecordFor (ThenCompute)
DontCopy T)
(PUTPROPS ThenConjecture Worth 600
IsA (Slot CriterialSlot ReprConcept Anything)
SuperSlots (ThenParts)
DataType LispFn
FailedRecord (ThenConjectureFailedRecord)
Record (ThenConjectureRecord))
(PUTPROPS ThenConjectureFailedRecord Worth 300
IsA (Slot NonCriterialSlot ReprConcept RecordSlot Anything)
DataType DottedPair
FailedRecordFor (ThenConjecture)
DontCopy T)
(PUTPROPS ThenConjectureRecord Worth 300
IsA (Slot NonCriterialSlot ReprConcept RecordSlot Anything)
DataType DottedPair
RecordFor (ThenConjecture)
DontCopy T)
(PUTPROPS ThenDefineNewConcepts Worth 600
IsA (Slot CriterialSlot ReprConcept Anything)
SuperSlots (ThenParts)
DataType LispFn
FailedRecord (ThenDefineNewConceptsFailedRecord)
Record (ThenDefineNewConceptsRecord))
(PUTPROPS ThenDefineNewConceptsFailedRecord Worth 300
IsA (Slot NonCriterialSlot ReprConcept RecordSlot
Anything)
DataType DottedPair
FailedRecordFor (ThenDefineNewConcepts)
DontCopy T)
(PUTPROPS ThenDefineNewConceptsRecord Worth 300
IsA (Slot NonCriterialSlot ReprConcept RecordSlot Anything)
DataType DottedPair
RecordFor (ThenDefineNewConcepts)
DontCopy T)
(PUTPROPS ThenDeleteOldConcepts Worth 600
IsA (Slot CriterialSlot ReprConcept Anything)
SuperSlots (ThenParts)
DataType LispFn
FailedRecord (ThenDeleteOldConceptsFailedRecord)
Record (ThenDeleteOldConceptsRecord))
(PUTPROPS ThenDeleteOldConceptsFailedRecord Worth 300
IsA (Slot NonCriterialSlot ReprConcept RecordSlot
Anything)
DataType DottedPair
FailedRecordFor (ThenDeleteOldConcepts)
DontCopy T)
(PUTPROPS ThenDeleteOldConceptsRecord Worth 300
IsA (Slot NonCriterialSlot ReprConcept RecordSlot Anything)
DataType DottedPair
RecordFor (ThenDeleteOldConcepts)
DontCopy T)
(PUTPROPS ThenModifySlots Worth 600
IsA (Slot CriterialSlot ReprConcept Anything)
SuperSlots (ThenParts)
DataType LispFn
FailedRecord (ThenModifySlotsFailedRecord)
Record (ThenModifySlotsRecord))
(PUTPROPS ThenModifySlotsFailedRecord Worth 300
IsA (Slot NonCriterialSlot ReprConcept RecordSlot Anything)
DataType DottedPair
FailedRecordFor (ThenModifySlots)
DontCopy T)
(PUTPROPS ThenModifySlotsRecord Worth 300
IsA (Slot NonCriterialSlot ReprConcept RecordSlot Anything)
DataType DottedPair
RecordFor (ThenModifySlots)
DontCopy T)
(PUTPROPS ThenParts Worth 600
IsA (Slot CriterialSlot ReprConcept Anything)
SubSlots (ThenCompute ThenModifySlots ThenConjecture ThenDefineNewConcepts
ThenDeleteOldConcepts ThenAddToAgenda ThenPrintToUser)
DataType LispFn)
(PUTPROPS ThenPrintToUser Worth 600
IsA (Slot CriterialSlot ReprConcept Anything)
SuperSlots (ThenParts)
DataType LispFn
FailedRecord (ThenPrintToUserFailedRecord)
Record (ThenPrintToUserRecord))
(PUTPROPS ThenPrintToUserFailedRecord Worth 300
IsA (Slot NonCriterialSlot ReprConcept RecordSlot Anything)
DataType DottedPair
FailedRecordFor (ThenPrintToUser)
DontCopy T)
(PUTPROPS ThenPrintToUserRecord Worth 300
IsA (Slot NonCriterialSlot ReprConcept RecordSlot Anything)
DataType DottedPair
RecordFor (ThenPrintToUser)
DontCopy T)
(PUTPROPS ToDelete Worth 600
IsA (Slot CriterialSlot ReprConcept Anything)
DataType LispFn)
(PUTPROPS ToDelete1 Worth 600
IsA (Slot CriterialSlot ReprConcept Anything)
DataType LispFn)
(PUTPROPS Transpose Worth 300
IsA (Slot NonCriterialSlot ReprConcept Anything)
DataType Unit
DoubleCheck T
Inverse (Transpose))
(PUTPROPS UnaryUnitOp Generalizations (UnitOp Anything)
Worth 500
IsA (ReprConcept Anything Category)
Abbrev (Operations performable upon a unit)
Specializations (Slot))
(PUTPROPS Undefined IsRangeOf (UndefinedPred)
Worth 100
IsA (Anything ReprConcept))
(PUTPROPS UndefinedPred Worth 100
IsA (Op Pred Anything UnaryOp MathOp UnaryPred)
Arity 1
Domain (Anything)
Range (Undefined)
ElimSlots (Applics))
(PUTPROPS Unit IsA (ReprConcept MathConcept Anything Category)
Worth 500
Generalizations (Anything ReprConcept))
(PUTPROPS UnitOp Generalizations (MathConcept Op MathOp SetOp Anything)
Worth 500
IsA (ReprConcept Anything Category)
Abbrev (Operations performable upon a set of units)
Specializations (UnaryUnitOp))
(PUTPROPS UnitizedAlg SuperSlots (Alg)
IsA (Slot CriterialSlot ReprConcept Anything)
Worth 600
DataType LispFn)
(PUTPROPS UnitizedDefn SuperSlots (Defn)
Worth 600
IsA (Slot CriterialSlot ReprConcept Anything)
DataType LispPred)
(PUTPROPS Worth Worth 305
IsA (Slot NonCriterialSlot ReprConcept Anything)
DataType Number)
(PUTPROPS los1 Worth 100
IsA (MathObj MathConcept Anything))
(PUTPROPS los2 Worth 100
IsA (MathObj MathConcept Anything))
(PUTPROPS los3 Worth 100
IsA (MathObj MathConcept Anything))
(PUTPROPS los4 Worth 100
IsA (MathObj MathConcept Anything))
(PUTPROPS los5 Worth 100
IsA (MathObj MathConcept Anything))
(PUTPROPS los6 Worth 100
IsA (MathObj MathConcept Anything))
(PUTPROPS los7 Worth 100
IsA (MathObj MathConcept Anything))
(PUTPROPS win1 Worth 904
IsA (MathObj MathConcept Anything))
[ADVISE (QUOTE EDITP)
(QUOTE BEFORE)
(QUOTE (OR (STKPOS (QUOTE EU))
(PRIN1 "
WARNING: ARE YOU SURE YOU REALLY DON'T MEAN 'EU' ??? !!! "]
(ADVISE (QUOTE MAKEFILE)
(QUOTE BEFORE)
(QUOTE (CheckElim)))
(ADVISE (QUOTE PRINTDEF)
(QUOTE AROUND)
(QUOTE (IF (NUMBERP (FIRSTATOM EXPR))
THEN
(RESETVARS (PRETTYFLG)
(RETURN *))
ELSE *)))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS AbortTask? AddedSome Agenda AreUnits CRLF CSlot CSlotSibs CTask Conjectures
CreditTo Creditors CurPri CurReasons CurSlot CurSup CurUnit CurVal DeletedUnits ESYSPROPS
EditpTemp FailureList GCredit GSlot HaveGenl HaveSpec HeuristicAgenda Interp LastEdited
MaybeFailed MapCycleTime MinPri MoveDefns NUnitSlots NeedGenl NeedSpec NewU NewUnit
NewUnits NewValue NewValues NotForReal nF nT OldKBPu OldKBPv OldVal OldValue PosCred RArrow
RCU SPACE SYSPROPS ShorterNam SlotToChange SlotsToChange SlotsToElimInitially Slots
SpecialNonUnits SynthU TTY TaskNum TempCaches UDiff UndoKill Units UnusedSlots UsedSlots
UserImpatience Verbosity WarnSlots conjec cprintmp)
)
(SETQ SYSPROPS (UNION ESYSPROPS SYSPROPS))
(ADVISE (QUOTE LOGOUT)
(QUOTE BEFORE)
(QUOTE (DRIBBLE)))
(ADVISE (QUOTE LOGOUT)
(QUOTE AFTER)
(QUOTE (SOS)))
[AND (NULL (GETD (QUOTE OldPACK*)))
(PUTD (QUOTE OldPACK*)
(GETD (QUOTE PACK*)))
(PUTD (QUOTE PACK*)
(GETD (QUOTE SmartPACK*]
(InitializeEurisko)
(CPRIN1 0 CRLF "You may call (InitialCheckInv) to ferret out references to now-defunct units" CRLF
CRLF "Type (Eurisko) when you are ready to start." CRLF CRLF)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA EU)
(ADDTOVAR NLAML )
(ADDTOVAR LAMA SmartPACK* CPRIN1)
)
(DECLARE: DONTCOPY
(FILEMAP (NIL (13427 102762 (APPLYEVAL 13437 . 13562) (AddInv 13564 . 13893) (AddNN 13895 . 14023) (
AddPropL 14025 . 14340) (Alg 14342 . 14548) (AllPairs 14550 . 14877) (ApplicArgs 14879 . 14993) (
ApplicGenArgs 14995 . 15114) (ApplicGenBuild 15116 . 15235) (ApplicGenInit 15237 . 15354) (Apply-to-u
15356 . 15475) (ApplyAlg 15477 . 15621) (ApplyDefn 15623 . 15769) (ApplyRule 15771 . 16315) (Average
16317 . 16453) (AverageWorths 16455 . 16637) (BestChoose 16639 . 16910) (BestSubset 16912 . 17194) (
CPRIN1 17196 . 17466) (CacheExamples 17468 . 17660) (Certainty 17662 . 17973) (Check2AfterEditp 17975
. 18265) (CheckAfterEditp 18267 . 18651) (CheckElim 18653 . 18862) (CheckTheValues 18864 . 19145) (
Comp 19147 . 19431) (ConsNN 19433 . 19574) (CreateUnit 19576 . 20554) (CurSup 20556 . 20676) (
CycleThruAgenda 20678 . 21059) (Date2 21061 . 21392) (DecrementCreditAssignment 21394 . 21544) (
DefineIfSlot 21546 . 21742) (DefineSlot 21744 . 22270) (Defn 22272 . 22599) (DirectApplics 22601 .
22798) (Divides 22800 . 22926) (DoesIntersect 22928 . 23085) (DreplaceGet 23087 . 23370) (
DwimUnionProp 23372 . 24132) (EU 24134 . 24982) (EVERY2 24984 . 25210) (EqualToWithinSubst 25212 .
25610) (Eurisko 25612 . 26032) (Examples 26034 . 26350) (ExtractInput 26352 . 26468) (ExtractOutput
26470 . 26588) (ExtractPriority 26590 . 26711) (ExtractReasons 26713 . 26836) (ExtractSlotName 26838
. 26961) (ExtractUnitName 26963 . 27086) (FavorFirst 27088 . 27256) (FirstTwo 27258 . 27388) (Flatten
27390 . 27584) (FractionOf 27586 . 27929) (GatherExamples 27931 . 28259) (GenArgs 28261 . 28374) (
GenBuild 28376 . 28489) (GenInit 28491 . 28602) (Generalizations 28604 . 28910) (Generalize1LispExpr
28912 . 29795) (Generalize1LispFn 29797 . 29936) (Generalize1LispPred 29938 . 30079) (GeneralizeBit
30081 . 30198) (GeneralizeCompiledLispCode 30200 . 30325) (GeneralizeDataType 30327 . 30674) (
GeneralizeDottedPair 30676 . 30795) (GeneralizeIOPair 30797 . 31125) (GeneralizeLispFn 31127 . 31894)
(GeneralizeLispPred 31896 . 32669) (GeneralizeList 32671 . 33136) (GeneralizeNIL 33138 . 33327) (
GeneralizeNumber 33329 . 33872) (GeneralizeSlot 33874 . 34213) (GeneralizeText 34215 . 34680) (
GeneralizeUnit 34682 . 35021) (GetABag 35023 . 35140) (GetAList 35142 . 35423) (GetAOPair 35425 .
35554) (GetAOSet 35556 . 35689) (GetASet 35691 . 35823) (GetAStruc 35825 . 36098) (GoodChoose 36100 .
36378) (GoodSubset 36380 . 36515) (Half 36517 . 36633) (HasHighWorth 36635 . 36790) (ISQRT 36792 .
36907) (IndirectApplics 36909 . 37111) (InitialCheckInv 37113 . 38413) (InitialElimSlots 38415 . 38667
) (InitializeCreditAssignment 38669 . 38808) (InitializeEurisko 38810 . 41155) (InsideOf 41157 . 41391
) (Instances 41393 . 41651) (Interestingness 41653 . 42504) (Interp1 42506 . 42851) (Interp2 42853 .
44071) (Interp2 44073 . 45291) (Interp3 45293 . 46614) (Interrupts 46616 . 47365) (IsAKindOf 47367 .
47514) (IsAlto 47516 . 47649) (IsSubsetOf 47651 . 47809) (KillSlot 47811 . 48488) (KillUnit 48490 .
49028) (KnownApplic 49030 . 49214) (LEQNN 49216 . 49360) (LessWorth 49362 . 49573) (ListifyIfNec 49575
. 49711) (ListsStarting 49713 . 49974) (ListsStartingAux 49976 . 50240) (MAP2EVERY 50242 . 50578) (
MAPAPPEND 50580 . 50787) (MAXIMUM 50789 . 51507) (MAXIMUM2 51509 . 52143) (Map&Print 52145 . 52307) (
MapApplics 52309 . 53782) (MapExamples 53784 . 55257) (MapUnion 55259 . 55631) (MergeProps 55633 .
56322) (MergeTasks 56324 . 57520) (MoreSpecific 57522 . 58220) (MostSpecific 58222 . 58363) (MyTime
58365 . 58594) (NU 58596 . 59724) (NUnitp 59726 . 59843) (NearnessTo 59845 . 60128) (NewNam 60130 .
60417) (NoRepeatsIn 60419 . 60652) (OKBinPreds 60654 . 61133) (OrderTasks 61135 . 61278) (PRINBOL
61280 . 61817) (PRINTASK 61819 . 62565) (PU 62567 . 63135) (PU2 63137 . 66224) (Percentify 66226 .
66390) (PunishSeverely 66392 . 66563) (Quoted 66565 . 66716) (REM1PROP 66718 . 66966) (RandomChoose
66968 . 67218) (RandomP 67220 . 67340) (RandomPair 67342 . 67479) (RandomSubset 67481 . 67726) (
RandomSubst 67728 . 68005) (RandomSubst* 68007 . 68301) (RepeatsIn 68303 . 68532) (ReportOn 68534 .
69045) (ResetPri 69047 . 69382) (RuleTakingTooLong 69384 . 69827) (RunAlg 69829 . 70572) (RunDefn
70574 . 71320) (SOME1 71322 . 71507) (SOS 71509 . 71875) (SQUARE 71877 . 71991) (START 71993 . 72848)
(SelfIntersect 72850 . 72978) (SetDiff 72980 . 73266) (SetDifference 73268 . 73562) (SetIntersect
73564 . 73717) (SetUnion 73719 . 73862) (Shorten 73864 . 73983) (SibSlots 73985 . 74138) (Sibs 74140
. 74280) (SlotNames 74282 . 74461) (SlotSubst 74463 . 74691) (Slotp 74693 . 74883) (SmartPACK* 74885
. 75690) (Snazzy 75692 . 79308) (SnazzyAgenda 79310 . 79849) (SnazzyConcept 79851 . 80267) (
SnazzyHeuristic 80269 . 80687) (SnazzyTask 80689 . 81823) (SomeOPair 81825 . 82170) (SomePair 82172 .
82332) (SomeUneliminated 82334 . 82631) (SortByWorths 82633 . 82767) (Specializations 82769 . 83075) (
Specialize1LispExpr 83077 . 83960) (Specialize1LispFn 83962 . 84101) (Specialize1LispPred 84103 .
84244) (SpecializeBit 84246 . 84363) (SpecializeCompiledLispCode 84365 . 84490) (SpecializeDataType
84492 . 84839) (SpecializeDottedPair 84841 . 84960) (SpecializeIOPair 84962 . 85290) (SpecializeLispFn
85292 . 86059) (SpecializeLispPred 86061 . 86834) (SpecializeList 86836 . 87237) (SpecializeNIL 87239
. 87428) (SpecializeNumber 87430 . 87854) (SpecializeSlot 87856 . 88195) (SpecializeText 88197 .
88598) (SpecializeUnit 88600 . 88939) (StrongUnsaveDef 88941 . 89142) (TakingTooLong 89144 . 89528) (
TakingTooMuchSpace 89530 . 89879) (TheFirstOf 89881 . 89990) (TheNumberOf 89992 . 90213) (TheSecondOf
90215 . 90325) (TinyReward 90327 . 90472) (TrueIfItExists 90474 . 91192) (UnGet 91194 . 92387) (
UnionProp 92389 . 92593) (UnionPropL 92595 . 92771) (Unitp 92773 . 93012) (WaxOn 93014 . 93572) (
WholeTask 93574 . 94033) (WorkOnTask 94035 . 96485) (WorkOnTask 96487 . 98937) (WorkOnUnit 98939 .
99856) (WorkOnUnit 99858 . 100775) (WorthWorkingOn 100777 . 100927) (XeqIfItExists 100929 . 102183) (
YesNo 102185 . 102433) (ZeroRecords 102435 . 102760)))))
STOP